QBSELECT - VOI06 Chọn ô

Tác giả: ladpro98

Ngôn ngữ: Pascal

program qbselect;
uses    math;
const   fi='';
var     com:array[0..15,0..15] of boolean;
        can:array[0..15] of boolean;
        a:array[1..10001,1..4] of longint;

        f,sum:array[0..10001,0..15] of longint;
        bit:array[0..15,1..4] of longint;
        n:longint;

procedure input;
var     inp:text;
var     i,j:longint;
begin
        assign(inp,fi);
        reset(inp);
        readln(inp,n);
        for j:=1 to 4 do
        for i:=1 to n do
        read(inp,a[i,j]);
        close(inp);
end;

function getbit(n,i:longint):longint;
begin
        exit((n shr (i-1)) and 1);
end;

procedure init;
var     i,j,k:longint;
begin
        fillchar(can,sizeof(can),true);
        fillchar(com,sizeof(com),true);
        for i:=1 to n do
        for j:=0 to 15 do
        f[i,j]:=low(longint);

        for i:=0 to 15 do
        for j:=1 to 4 do
        bit[i,j]:=getbit(i,j);

        for i:=1 to n do
        for j:=0 to 15 do
        begin
                for k:=1 to 4 do
                inc(sum[i,j],bit[j,k]*a[i,k]);
        end;
        for i:=0 to 15 do
        begin
                for j:=1 to 3 do
                if (getbit(i,j) = 1) and (getbit(i,j+1) = 1) then
                can[i]:=false;
        end;

        for i:=0 to 15 do
        for j:=0 to 15 do
        begin
                if (not can[i]) or (not can[j]) then
                begin
                        com[i,j]:=false;
                        continue;
                end;

                for k:=1 to 4 do
                if (getbit(i,k) = 1) and (getbit(j,k)=1) then
                        com[i,j]:=false;
        end;


end;

procedure dp;
var     i,j,k:longint;
begin
        for i:=1 to n do
        begin
                for j:=0 to 15 do
                begin

                    if not can[j] then continue;
                        for k:=0 to 15 do
                        if com[j,k] then
                                f[i,j]:=max(f[i,j],f[i-1,k]+sum[i,j]);
                end;
        end;
end;

procedure output;
var     res,i,j:longint;
begin

        res:=low(longint);
        for i:=0 to 15 do
        res:=max(res,f[n,i]);
        if res<>0 then
        write(res)
        else
        begin
                res:=a[1,1];
                for i:=1 to n do
                for j:=1 to 4 do
                res:=max(res,a[i,j]);
                write(res);
        end;
end;

begin
        input;
        init;
        dp;
        output;
end.

Download