SLIKAR - Slikar

Tác giả: ladpro98

Ngôn ngữ: Pascal

{$H+}
program slikar;
uses    math;
const   maxn=513;
        maxP = 10;
        oo=trunc(1e9);
        fi='';
        b = 1;//black;
        w = 0;//white;
        r = 2;//recursive;
var     f:array[1..maxn,1..maxn,0..maxP,0..2] of longint;
        //F[i,j,k,t] = Chenh lech min cua hinh vuong goc duoi phai la i,j, canh = 2^k, to theo cach t;
        check:array[1..maxn,1..maxn,0..maxP,0..2] of boolean;
        trace:array[1..maxn,1..maxn,0..maxP] of longint;
        res:array[1..maxn,1..maxn] of longint;
        a:array[1..maxn] of string;
        pow:array[0..10] of longint;
        per:array[0..30,0..4] of longint;
        n,pn,d:longint;

procedure input;
var     inp:text;
        i:longint;
begin
        assign(inp,fi);reset(inp);
        readln(inp,n);
        for i:=1 to n do readln(inp,a[i]);
        close(inp);
        pow[0]:=1;
        for i:=1 to 10 do pow[i]:=2*pow[i-1];
        for i:=0 to 10 do if pow[i] = n then pn:=i;
end;

procedure GenPer;
var     i,k,j,t:longint;
begin
        for i:=1 to 3 do
        for j:=i+1 to 4 do
        for t:=0 to 1 do
        begin
                inc(d);
                per[d,i]:=2;per[d,j]:=2;
                for k:=1 to 4 do
                if (k<>i) and (k<>j) then
                begin
                        per[d,k]:=t;
                        break;
                end;
                for k:=4 downto 1 do
                if (k<>i) and (k<>j) then
                begin
                        per[d,k]:=1-t;
                        break;
                end;
        end;
end;

function dp(i,j,k,t:longint):longint;
var     i1,i2,i3,j1,j2,j3,x,temp:longint;
begin
        if check[i,j,k,t] then exit(f[i,j,k,t]);
        check[i,j,k,t]:=true;
        if k=0 then
        begin
                if (t=2) or (a[i][j] = chr(t+48)) then f[i,j,k,t]:=0
                else    f[i,j,k,t]:=1;
                exit(f[i,j,k,t]);
        end;
        i1:=(i+i-pow[k]) shr 1; j1:=(j+j-pow[k]) shr 1;
        i2:=i1;j2:=j;
        i3:=i; j3:=j1;
        if (t<2) then
        f[i,j,k,t]:=dp(i1,j1,k-1,t)+dp(i2,j2,k-1,t)+dp(i3,j3,k-1,t)+dp(i,j,k-1,t)
        else
        begin
                f[i,j,k,t]:=oo;
                for x:=1 to d do
                begin
                        temp:=
                        dp(i1,j1,k-1,per[x,1])+dp(i2,j2,k-1,per[x,2])+
                        dp(i3,j3,k-1,per[x,3])+dp(i,j,k-1,per[x,4]);
                        if f[i,j,k,t]>temp then
                        begin
                                f[i,j,k,t]:=temp;
                                trace[i,j,k]:=x;
                        end;
                end;
        end;
        exit(f[i,j,k,t]);
end;

procedure print(i,j,k,t:longint);
var     p,q,i1,i2,i3,j1,j2,j3:longint;
begin
        if (t<2) then
        begin
                for p:=i-pow[k]+1 to i do
                for q:=j-pow[k]+1 to j do
                res[p,q]:=t;
                exit;
        end;
        if k=0 then
        begin
                res[i,j]:=ord(a[i][j])-48;
                exit;
        end;
        i1:=(i+i-pow[k]) shr 1; j1:=(j+j-pow[k]) shr 1;
        i2:=i1;j2:=j;
        i3:=i; j3:=j1;
        print(i1,j1,k-1,per[trace[i,j,k],1]);
        print(i2,j2,k-1,per[trace[i,j,k],2]);
        print(i3,j3,k-1,per[trace[i,j,k],3]);
        print(i,j,k-1,per[trace[i,j,k],4]);
end;

procedure process;
var     i,j:longint;
begin
        writeln(dp(n,n,pn,r));
        print(n,n,pn,r);
        for i:=1 to n do
        begin
                for j:=1 to n do write(res[i,j]);
                writeln;
        end;
end;

begin
        input;
        GenPer;
        process;
end.

Download