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.

Download