9-22考试题目 结题报告

const letter=['0'..'9']+['a'..'f']; 
      inf='encode.in';
      ouf='encode.out';
var
        a:array [1..9,1..32] of longint;
        f:array [1..33,0..100] of longint;
        pa:array [1..33,0..100] of longint;
        ans,m:string;

        procedure getstr(var s:string);
        var ch:char;
        begin
        repeat
                read(ch);
                until ch in letter;
                s:='';
                repeat
                case ch of
                '0':s:=s+'0000';
                '1':s:=s+'0001';
                '2':s:=s+'0010';
                '3':s:=s+'0011';
                '4':s:=s+'0100';
                '5':s:=s+'0101';
                '6':s:=s+'0110';
                '7':s:=s+'0111';
                '8':s:=s+'1000';
                '9':s:=s+'1001';
                'a':s:=s+'1010';
                'b':s:=s+'1011';
                'c':s:=s+'1100';
                'd':s:=s+'1101';
                'e':s:=s+'1110';
                'f':s:=s+'1111';
        end;
        if eoln then break;
        read(ch);
        until not (ch in letter);
        end;

        procedure init;
        var p,q:longint;
        st:string;

        begin
                assign(input,inf);
                reset(input);
                for p:=1 to 9 do
                begin
                getstr(st);
                while length(st)<32 do st:='0'+st;
                for q:=1 to 32 do
                a[p,q]:=ord(st[33-q])-ord('0');
                end;
        close(input);
        fillchar(f,sizeof(f),$ff);
        end;

        function getsum(x,y,num:longint):longint;
        var tmp,u               :longint;
        begin
                tmp:=y;
                for u:=1 to 8 do
                tmp:=tmp+(a[u,x] xor num);
                getsum:=tmp;
        end;

        procedure getvalue(x,y:longint);
        var now,num:longint;
        begin
                if f[x,y]<>-1 then exit;
                if x>32 then begin
                f[x,y]:=1;
                exit;
                end;
                f[x,y]:=0;
                for num:=0 to 1 do begin
                now:=getsum(x,y,num);
                if now and 1<>a[9,x] xor num then continue;
                getvalue(x+1,now shr 1);
                if f[x+1,now shr 1]=1 then begin
                f[x,y]:=1;
                pa[x,y]:=num;
                break;
                end;
                end;
        end;

        procedure getans;
        var p,q:longint;
        begin
                ans:='';
                p:=1;
                q:=0;
                while p<=32 do begin
                        ans:=chr(48+pa[p,q])+ans;
                        q:=getsum(p,q,pa[p,q]) shr 1;
                        inc(p);
                end;
        end;

        procedure main;
        var tmp:string;
        begin
                getvalue(1,0);
                getans;
                m:='';
                while ans<>'' do begin
                tmp:=copy(ans,1,4);
                if tmp='0000' then m:=m+'0' else
                if tmp='0001' then m:=m+'1' else
                if tmp='0010' then m:=m+'2' else
                if tmp='0011' then m:=m+'3' else
                if tmp='0100' then m:=m+'4' else
                if tmp='0101' then m:=m+'5' else
                if tmp='0110' then m:=m+'6' else
                if tmp='0111' then m:=m+'7' else
                if tmp='1000' then m:=m+'8' else
                if tmp='1001' then m:=m+'9' else
                if tmp='1010' then m:=m+'a' else
                if tmp='1011' then m:=m+'b' else
                if tmp='1100' then m:=m+'c' else
                if tmp='1101' then m:=m+'d' else
                if tmp='1110' then m:=m+'e' else
                if tmp='1111' then m:=m+'f';
                delete(ans,1,4);
                end;
                while (length(m)>1) and (m[1]='0') do delete(m,1,1);
                assign(output,ouf);
                rewrite(output);
                writeln(m);
                close(output);
        end;

        begin
                init;
                main;
        end.

const 
        maxn=1000;
        maxt=1100;
        inf='work.in';
        ouf='work.out';
var 
        t,a,b :array [0..maxn] of longint;
        f:array [0..maxt+1] of longint;
        n,start:longint;

procedure init;
var p:longint;
begin
        start:=maxt;
        assign(input,inf);
        reset(input);
        readln(n);
        for p:=1 to n do begin
            readln(t[p],a[p],b[p]);
            if a[p]<start then start:=a[p];
        end;
    close(input);
end;

procedure main;
var 
    i,j:longint;
    find:boolean;
begin
    fillchar(f,sizeof(f),$ff);
    f[start]:=0;
    for i:=start to maxt do
    if f[i]<>-1 then begin
        find:=false;
        for j:=1 to n do
            if (a[j]<=i) and (i+t[j]<=b[j]) then begin
            find:=true;
            if (f[i+t[j]]=-1) or (f[i+t[j]]>f[i]+t[j]) then
            f[i+t[j]]:=f[i]+t[j];
        end;
        if not find then
        if (f[i+1]=-1) or (f[i+1]>f[i]) then f[i+1]:=f[i];
    end;
    assign(output,ouf);
    rewrite(output);
    writeln(f[maxt]);
    close(output);
end;

begin
    init;
    main;
end.

 喜欢就收藏一下，vic私人qq：1064864324，加我一起讨论问题，一起进步^-^