Cod sursa(job #1305052)

Utilizator ButnaruButnaru George Butnaru Data 29 decembrie 2014 15:17:58
Problema PScPld Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.37 kb
program pscpld2d;
type
tabel=array[-30..1010,-30..1010] of char;
buf=array[0..1 shl 17] of char;
var
ff1,ff2:buf;
t:tabel;
n,i,j,k,x,y,nr:longint;
f1,f2:text;
function palindrom(a,b,c:longint):boolean;
var i,k:longint; ok:boolean;
begin
ok:=true; k:=0;
for i:=b to (b+c) div 2 do
if t[a,i]<>t[a,c-k] then begin ok:=false; break; end else
k:=k+1;
palindrom:=ok;
end;
function pall(a,b,c:longint):boolean;
var i,k:longint; ok:boolean;
begin
ok:=true; k:=0;
for i:=b to (b+c) div 2 do
if t[i,a]<>t[c-k,a] then begin ok:=false; break; end else
k:=k+1;
pall:=ok;
end;
function pal(x1,y1,x2,y2:longint):boolean;
var i,j:longint; ok:boolean;
begin
ok:=true;
for i:=x1 to x2 do
if not palindrom(i,y1,y2) then begin ok:=false; break; end;
if ok then begin
for i:=y1 to y2 do
if not pall(i,x1,x2) then begin ok:=false; break; end;
end;
pal:=ok;
end;
begin
assign (f1,'pscpld2d.in');
assign (f2,'pscpld2d.out');
reset (f1);
rewrite (f2);
settextbuf(f1,ff1);
settextbuf(f2,ff2);
readln (f1,n);
for i:=1 to n do begin
for j:=1 to n do
read (f1,t[i,j]);
readln (f1);
end;
nr:=n*n;
for i:=1 to n-2 do
for j:=1 to n-2 do begin
k:=3;
while (i+k-1<=n) and (j+k-1<=n) do begin
if (t[i,j]=t[i,j+k-1]) and (t[i,j]=t[i+k-1,j]) and (t[i,j]=t[i+k-1,j+k-1]) then
if pal(i,j,i+k-1,j+k-1) then nr:=nr+1;
k:=k+2;
end;
end;
writeln (f2,nr);
close (f1);
close (f2);
end.