QBSELECT - VOI06 Chọn ô

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI}
Program QBSELECT;
        Const
                input  = '';
                output = '';
        Var
                    a: array[0..4,1..10000] of integer;
                    F: array[0..15,1..10000] of integer;
                power: array[0..3] of integer;
                stack: array[0..15,1..4] of integer;
                n,max: integer;

Procedure init;
          Var
                fi: text;
               i,j: integer;
          Begin
                Fillchar(a, sizeof(a), 0);

                Assign(fi, input);
                        Reset(fi);

                        Readln(fi, n);
                        max:= -32000;

                        For i:= 1 to 4 do
                                For j:= 1 to n do
                                        Begin
                                                Read(fi, a[i,j]);
                                                If max < a[i,j] then max:= a[i,j];
                                        End;
                Close(fi);
          End;

Procedure pwr;
          Var
                i: integer;
          Begin
                power[0]:= 1;
                For i:= 1 to 3 do power[i]:= power[i - 1] shl 1;
          End;

Procedure adj;
          Var
                i,j,k: integer;
          Begin
                For i:= 0 to 15 do
                        If i and (i shl 1) = 0 then
                                Begin
                                        j:= 0;
                                        For k:= 0 to 3 do
                                                if (i and power[k]) = power[k] then
                                                        Begin
                                                                inc(j);
                                                                stack[i,j]:= k + 1;
                                                        End;
                                End;
          End;

Procedure optimize;
          Var
                i,j,k,s,tmp: integer;
          Begin
                Fillchar(F, sizeof(F), 0);

                For i:= 0 to 15 do
                        For j:= 1 to 4 do F[i,1]:= F[i,1] + a[stack[i,j],1];

                        For k:= 2 to n do
                                For i:= 0 to 15 do if (i and (i shl 1) = 0) then
                                    Begin
                                        F[i,k]:= low(integer);
                                        For j:= 0 to 15 do
                                                if (i and j = 0) and (j and (j shl 1) = 0) then
                                                        Begin
                                                                tmp:= F[j,k - 1];
                                                                If F[i,k] < tmp then F[i,k]:= tmp;
                                                        End;
                                        For s:= 1 to 4 do F[i,k]:= F[i,k] + a[stack[i,s],k];
                                    End;
          End;

Procedure solve;
          Var
                    fo: text;
                 i,num: integer;
          Begin
                Assign(fo, output);
                        Rewrite(fo);

                        num:= 0;
                        For i:= 0 to 15 do if num < F[i,n] then num:= F[i,n];

                        If num = 0 then writeln(fo, max) else writeln(fo, num);
                Close(fo);
          End;

Begin
        init;
        pwr;
        adj;
        optimize;
        solve;
End.

Download