Cod sursa(job #1144432)

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

function verif(x,y:longint):boolean;
var h:longint;
begin
  verif := true;
  for h := 1 to 26 do
  begin
    if ((a[h,x+m-1,y+m-1] - a[h,x-1,y+m-1] - a[h,x+m-1,y-1] + a[h,x-1,y-1]) <> s[h]) then
    begin
      verif := false;
      exit;
    end;
  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); op := ord(c) - $60 ;
      a[0,i,j] := op;
      for h := 1 to 26 do
      begin
        if op = h then a[h,i,j] := 1 else a[h,i,j] := 0;
      end;
    end;
    readln();
  end;

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

  for i := 1 to n do
    for j := 1 to n do
      for h := 0 to 26 do
        a[h,i,j] := a[h,i,j] + a[h,i-1,j] + a[h,i,j-1] - a[h,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[0,i+m-1,j+m-1] - a[0,i+m-1,j-1] - a[0,i-1,j+m-1] + a[0,i-1,j-1]) = sum then
        if verif(i,j) then inc(cont);
    end;

  writeln(cont);


  {for i := 1 to n do
  begin
    for j := 1 to n do
      write(a[0,i,j],' ');
    writeln();
  end;   }

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