Cod sursa(job #1144427)

Utilizator atatomirTatomir Alex atatomir Data 17 martie 2014 08:25:01
Problema Matrix Scor 55
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
var n,m,i,j,sum,op,cont:longint;
    s,l:array[1..26]of longint;
    a,ai:array[0..1005,0..1005]of longint;
    c:char;

function verif(x,y:longint):boolean;
var i,j,h:longint;
begin
  verif := true;
  for i := 1 to 26 do l[i] := 0;

  for i := 1 to m do
    for j := 1 to m do
    begin
      h := ai[x+i-1,y+j-1];
      inc(l[h]);
      if l[h] > s[h] then
      begin
        verif := false;
        exit;
      end;
    end;

  for i := 1 to 26 do
    if l[i] <> s[i] then
    begin
      verif := false;
      exit;
    end;

end;

begin
  assign(input,'matrix.in'); reset(input);
  assign(output,'matrix.out'); rewrite(output);

  readln(n,m);

  for i := 1 to n do
  begin
    for j := 1 to n do
    begin
      read(c);
      a[i,j] := ord(c) - $60; ai[i,j] := a[i,j];
    end;
    readln();
  end;

  for i := 0 to n+1 do
  begin
    a[0,i] := 0;
    a[n+1,i] := 0;
    a[i,0] := 0;
    a[i,n+1] := 0;
  end;

  for i := 1 to n do
    for j := 1 to n do
      a[i,j] := a[i,j] + a[i-1,j] + a[i,j-1] - a[i-1,j-1];

  for i := 1 to 26 do s[i] := 0;
  sum := 0;

  for i := 1 to m do
  begin
    for j := 1 to m do
    begin
      read(c); op := ord(c) - $60;
      inc(s[op]);
      sum := sum + op;
    end;
    readln();
  end;

  cont := 0;

  for i := 1 to n-m+1 do
    for j := 1 to n-m+1 do
    begin
      if a[i+m-1,j+m-1] - a[i+m-1,j-1] - a[i-1,j+m-1] + a[i-1,j-1] = sum then
        if verif(i,j) then inc(cont);
    end;

  writeln(cont);

  close(input);
  close(output);
end.