QBGAME - Trò chơi trên ma trận

Tác giả: RR

Ngôn ngữ: Pascal

//Written by Nguyen Thanh Trung
{$R+,Q+}
{$Mode objFPC}
uses math;
const
  FINP          =       '';
  FOUT          =       '';
  MAXN          =       10111;
var
  f1,f2         :       text;
  n,stt         :       longint;
  a             :       array[1..8,0..MAXN] of longint;
  tt            :       array[1..100] of longint;
  d,sum         :       array[0..MAXN,1..100] of int64;
  list          :       array[1..100,1..100] of longint;
  deg           :       array[1..100] of longint;

procedure openF;
    begin
      assign(f1,FINP); reset(f1);
      assign(f2,FOUT); rewrite(f2);
    end;
procedure closeF;
    begin
      close(f1);
      close(f2);
    end;
procedure inp;
    var
      i,j:longint;
    begin
      read(f1,n);
      for i:=1 to 8 do
      for j:=1 to n do
        read(f1,a[i,j]);
    end;
procedure gen;
    var
      i,j,bit:longint;
    begin
      stt:=0;
      for i:=0 to 255 do
        if (i and (i>>1)=0) and (i and (i<<1)=0) then
          begin
            inc(stt);
            tt[stt]:=i;
          end;
      for i:=1 to stt do
      for j:=1 to stt do
        if tt[i] and tt[j]=0 then
          begin
            inc(deg[i]);
            list[i,deg[i]]:=j;
          end;
      for i:=1 to n do
      for j:=1 to stt do
        for bit:=1 to 8 do
          if (tt[j]>>(bit-1)) and 1=1 then
            inc(sum[i,j],a[bit,i]);
    end;
procedure solve;
    var
      i,j,now,next:longint;
      kq:int64;
    begin
      kq:=-1000111000111;
      for i:=1 to n-1 do
      for now:=1 to stt do
        d[i,now]:=kq;
      for i:=0 to n-1 do
      for now:=1 to stt do
        for j:=1 to deg[now] do
          begin
            next:=list[now,j];
            d[i+1,next]:=max(d[i+1,next],d[i,now]+sum[i+1,next]);
          end;
      for now:=1 to stt do
        kq:=max(kq,d[n,now]);
      writeln(f2,kq);
    end;
procedure refine;
    var
      i,j:longint;
      ln:int64;
    begin
      ln:=-1000111000111;
      for i:=1 to 8 do
      for j:=1 to n do
        if a[i,j]>0 then exit
        else ln:=max(ln,a[i,j]);
      writeln(f2,ln);
      closeF; halt;
    end;

begin
  openF;
  inp;
  gen;
  refine;
  solve;
  closeF;
end.

Download