CRECT - Đếm các hình chữ nhật
Tác giả: flashmt
Ngôn ngữ: Pascal
const fi=''; fo=''; maxn=404;var n,m:longint; re:int64; a:array[1..maxn,1..maxn] of char; h,st:array[0..maxn] of longint; num:array[0..maxn] of int64; r:array['A'..'E','A'..'E'] of int64; procedure rf;var i,j:longint;begin assign(input,fi); reset(input); readln(m,n); for i:=1 to m do begin for j:=1 to n do read(a[i,j]); readln; end; close(input);end; function calc(x,y,z:char):int64;var i,j,t,now:longint; res:int64;begin fillchar(h,sizeof(h),0); h[0]:=-1; res:=0; for i:=1 to m do begin fillchar(st,sizeof(st),0); fillchar(num,sizeof(num),0); now:=0; for j:=1 to n do begin if (a[i,j]=x) or (a[i,j]=y) or (a[i,j]=z) then h[j]:=h[j]+1 else h[j]:=0; while h[st[now]]>=h[j] do dec(now); t:=st[now]; inc(now); st[now]:=j; num[j]:=h[j]*(j-t)+num[t]; res:=res+num[j]; end; end; calc:=res;end; procedure pr;var x,y,z:char;begin re:=0; for x:='A' to 'E' do r[x,x]:=calc(x,x,x); for x:='A' to 'D' do for y:=chr(ord(x)+1) to 'E' do r[x,y]:=calc(x,y,y); for x:='A' to 'C' do for y:=chr(ord(x)+1) to 'D' do for z:=chr(ord(y)+1) to 'E' do re:=re+calc(x,y,z)-r[x,y]-r[x,z]-r[y,z]+r[x,x]+r[y,y]+r[z,z];end; procedure wf;begin assign(output,fo); rewrite(output); writeln(re); close(output);end; begin rf; pr; wf;end.