CREC01 - Đếm hình chữ nhật trên bảng 0-1
Tác giả: RR
Ngôn ngữ: Pascal
//Written by RR
{$IFDEF RR}
{$R+,Q+,S+}
{$inline off}
{$Mode objFPC}
{$ELSE}
{$R-,Q-}
{$inline on}
{$Mode objFPC}
{$ENDIF}
uses math;
const
FINP = {$IFDEF RR} 'input.txt'; {$ELSE} ''; {$ENDIF}
FOUT = {$IFDEF RR} 'output.txt'; {$ELSE} ''; {$ENDIF}
MAXN = 1111;
var
f1,f2 : text;
m,n : longint;
a : array[1..MAXN,1..MAXN] of byte;
h,stack : array[0..MAXN] of longint;
left,right : array[0..MAXN] of longint;
ok : array[0..MAXN] of boolean;
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;
ch:char;
begin
readln(f1,m,n);
for i:=1 to m do
begin
for j:=1 to n do
begin
read(f1,ch);
if ch='0' then a[i,j]:=0 else a[i,j]:=1;
end;
readln(f1);
end;
end;
procedure solve;
var
count:int64;
i,j,k:longint;
l,r:longint;
top:longint;
begin
count:=0;
for i:=1 to m do
begin
for j:=1 to n do
if a[i,j]=1 then inc(h[j]) else h[j]:=0;
top:=0; stack[0]:=0;
for j:=1 to n do
begin
while (top>0) and (h[stack[top]]>=h[j]) do dec(top);
left[j]:=stack[top]+1;
inc(top); stack[top]:=j;
end;
top:=0; stack[0]:=n+1;
for j:=n downto 1 do
begin
while (top>0) and (h[stack[top]]>=h[j]) do dec(top);
right[j]:=stack[top]-1;
inc(top); stack[top]:=j;
end;
top:=0; stack[0]:=0;
for j:=1 to n do
begin
while (top>0) and (h[stack[top]]>h[j]) do dec(top);
if h[stack[top]]=h[j] then ok[j]:=false else ok[j]:=true;
inc(top); stack[top]:=j;
end;
{$IFDEF RR}
writeln(f2);
writeln(f2,'=============');
writeln(f2,'Hang ',i);
for j:=1 to n do write(f2,h[j],' '); writeln(f2);
writeln(f2,'left: ');
for j:=1 to n do write(f2,left[j],' '); writeln(f2);
writeln(f2,'right: ');
for j:=1 to n do write(f2,right[j],' '); writeln(f2);
writeln(f2,'ok: ');
for j:=1 to n do
if ok[j] then write(f2,'1 ') else write(f2,'0 ');
writeln(f2);
writeln(f2,'============');
writeln(f2);
{$ELSE}
{$ENDIF}
for j:=1 to n do
if ok[j] then
begin
l:=left[j]; r:=right[j];
k:=max(h[l-1],h[r+1]);
inc(count,(r-l+1)*(r-l+2)*(h[j]-k)>>1);
{$IFDEF RR}
writeln(f2,' cot ',j);
writeln(f2,' left = ',l,' right = ',r,' count+= ',(r-l+1)*(r-l+2)*(h[j]-k)>>1);
{$ELSE}
{$ENDIF}
end;
end;
writeln(f2,count);
end;
begin
openF;
inp;
solve;
closeF;
end.