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

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI}
Program QBGAME;
        Const
                input  = '';
                output = '';
                  maxc = -1000000000;
        Var
                    a: array[1..8,1..10000] of longint;
                    F: array[0..55,1..10000] of int64;
                    h: array[1..56] of longint;
                  val: array[1..55] of longint;
                stack: array[1..55,1..8] of byte;
                  adj: array[1..7000] of longint;
                    n: integer;
                  max: int64;

Procedure init;
          Var
                fi: text;
               i,j: integer;
          Begin
                Assign(fi, input);
                        Reset(fi);

                        Readln(fi, n);
                        max:= low(longint);

                        For i:= 1 to 8 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 MakeGraph;
          Var
                count,i,j,vertex: integer;
          Begin
                vertex:= 0;
                For i:= 0 to 255 do if i and (i shl 1) = 0 then
                  Begin
                        inc(vertex);
                        val[vertex]:= i;
                        For j:= 0 to 7 do if (i and (1 shl j)) = (1 shl j)
                                then stack[vertex,j + 1]:= 1 else stack[vertex,j + 1]:= 0;
                  End;

                count:= 0;
                vertex:= 0;

                For i:= 0 to 255 do if i and (i shl 1) = 0 then
                  Begin
                        inc(vertex);
                        h[vertex]:= count;
                        For j:= 1 to 55 do if i and val[j] = 0 then
                          Begin
                                inc(count);
                                adj[count]:= j;
                          End;
                  End;

                h[vertex + 1]:= count;
          End;

Procedure optimize;
          Var
                i,j,k,s,ij: integer;
          Begin
                For i:= 1 to 55 do F[i,1]:= 0;
                For i:= 1 to 55 do
                    For k:= 1 to 8 do if stack[i,k] = 1
                                      then F[i,1]:= F[i,1] + a[k,1];

                For s:= 2 to n do
                  For i:= 1 to 55 do
                    Begin
                      F[i,s]:= maxc;
                      For ij:= h[i] + 1 to h[i + 1] do
                        Begin
                                j:= adj[ij];
                                if F[i,s] < F[j,s - 1]
                                  then F[i,s]:= F[j,s - 1];
                        End;

                      For j:= 1 to 8 do if stack[i,j] = 1
                                then F[i,s]:= F[i,s] + a[j,s];
                    End;
          End;

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

                        num:= 0;
                        For i:= 1 to 55 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;
        MakeGraph;
        optimize;
        solve;
End.

Download