BCHESS - Bàn cờ tướng

Tác giả: ladpro98

Ngôn ngữ: Pascal

program bchess;
uses    math;
const   fi='';
        maxn=2222;
var     n:longint;
        a:array[1..maxn] of ansistring;
        f1a,f1b,f2,f3:array[1..maxn,1..maxn] of int64;
        res1,res2,res3,c1,c2,c3:int64;

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

function min3(a,b,c:int64):int64;
begin
        exit(min(min(a,b),c));
end;

procedure process;
var     i,j:longint;
begin
        for j:=1 to n do
        begin
                if a[1][j]='0' then
                begin
                        f2[1,j]:=0;
                        f3[1,j]:=1;
                        res3:=1;
                end
                else
                begin
                        f2[1,j]:=1;
                        f3[1,j]:=0;
                        res2:=1
                end;
                f1a[1,j]:=0;
                f1b[1,j]:=0;

        end;
        for i:=1 to n do
        begin
                if a[i][1]='0' then
                begin
                        f2[i,1]:=0;
                        f3[i,1]:=1;
                        res3:=1;

                end
                else
                begin
                        f2[i,1]:=1;
                        f3[i,1]:=0;
                        res2:=1;

                end;
                f1a[i,1]:=0;
                f1b[i,1]:=0;
        end;

        for i:=2 to n do
        for j:=2 to n do
        begin
                if (a[i][j]=a[i-1][j-1]) and (a[i-1][j]=a[i][j-1]) then
                begin
                        if a[i][j]='0' then
                        begin
                                f1a[i,j]:=min3(f2[i,j-1],f2[i-1,j],f3[i-1,j-1])+1;
                                f1b[i,j]:=0;
                                f2[i,j]:=0;
                                f3[i,j]:=min3(f1b[i,j-1],f1b[i-1,j],f1a[i-1,j-1])+1;
                        end
                        else
                        begin
                                f1a[i,j]:=0;
                                f1b[i,j]:=min3(f3[i,j-1],f3[i-1,j],f2[i-1,j-1])+1;
                                f2[i,j]:=min3(f1a[i,j-1],f1a[i-1,j],f1b[i-1,j-1])+1;
                                f3[i,j]:=0;
                        end;
                end
                else
                if a[i][j]='0' then
                        f3[i,j]:=1
                else
                        f2[i,j]:=1;
        end;
end;

procedure output;
var     i,j:longint;
begin
        for i:=1 to n do
        for j:=1 to n do
        begin
                res1:=max(res1,max(f1a[i,j],f1b[i,j]));
                res2:=max(res2,f2[i,j]);
                res3:=max(res3,f3[i,j]);
        end;
        for i:=1 to n do
        for j:=1 to n do
        begin
                if a[i][j]='0' then
                begin
                        if (res1>0) and (f1a[i,j]=res1) then inc(c1);
                        if (res3>0) and (f3[i,j]=res3) then inc(c3);
                end
                else
                begin
                        if (res1>0) and (f1b[i,j]=res1) then inc(c1);
                        if (res2>0) and (f2[i,j]=res2) then inc(c2);
                end;
        end;
        writeln(res1,' ',c1);
        writeln(res2,' ',c2);
        writeln(res3,' ',c3);
end;

begin
        input;
        process;
        output;
end.

Download