CRECT - Đếm các hình chữ nhật
Tác giả: ll931110
Ngôn ngữ: Pascal
program CRECT;
const
input = '';
output = '';
maxn = 400;
k: array[1..5] of char = ('A','B','C','D','E');
var
a: array[1..maxn,1..maxn] of char;
stack,h: array[0..maxn] of integer;
dp: array[0..maxn] of int64;
s: array[0..3] of integer;
m,n: integer;
res: int64;
procedure init;
var
f: text;
i,j: integer;
begin
assign(f, input);
reset(f);
readln(f, m, n);
for i := 1 to m do
begin
for j := 1 to n do read(f, a[i,j]);
readln(f);
end;
close(f);
end;
procedure precalc;
begin
res := 0;
s[0] := 0;
stack[0] := 0;
dp[0] := 0;
end;
function calc(x,y,z: integer): int64;
var
i,j,top,tmp: integer;
t: int64;
begin
fillchar(h, sizeof(h), 0);
h[0] := -1;
t := 0;
for i := 1 to m do
begin
for j := 1 to n do
if ((a[i,j] = k[x]) or (a[i,j] = k[y]) or (a[i,j] = k[z])) then inc(h[j]) else h[j] := 0;
top := 0;
for j := 1 to n do
begin
while h[j] <= h[stack[top]] do dec(top);
tmp := stack[top];
dp[j] := (j - tmp) * h[j] + dp[tmp];
t := t + dp[j];
inc(top);
stack[top] := j;
end;
end;
calc := t;
end;
procedure update;
var
t: int64;
begin
t := calc(s[1],s[2],s[3]);
t := t - calc(s[1],s[1],s[2]) - calc(s[2],s[2],s[3]) - calc(s[3],s[3],s[1]);
t := t + calc(s[1],s[1],s[1]) + calc(s[2],s[2],s[2]) + calc(s[3],s[3],s[3]);
res := res + t;
end;
procedure attempt(i: integer);
var
j: integer;
begin
for j := s[i - 1] + 1 to 5 do
begin
s[i] := j;
if i < 3 then attempt(i + 1) else update;
end;
end;
procedure printresult;
var
f: text;
begin
assign(f, output);
rewrite(f);
writeln(f, res);
close(f);
end;
begin
init;
precalc;
attempt(1);
printresult;
end.