Cod sursa(job #1144565)

Utilizator atatomirTatomir Alex atatomir Data 17 martie 2014 12:05:35
Problema Matrix Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.48 kb
var n,m,i,j,op,h:longint;
    a,l:array[0..1005,0..1005]of byte;
    s:array[1..26]of longint;
    c:char;
    ok:array[1..1000,1..1000]of boolean;
    cont:longint;
 
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[i,j] := op;
    end;
    readln();
  end;
 
  for i := 1 to 26 do s[i] := 0;
 
  for i := 1 to m do
  begin
    for j := 1 to m do
    begin
      read(c); op := ord(c) - $60;
      inc(s[op]);
    end;
    readln();
  end;
 
  for i := 0 to n+1 do
  begin
    l[0,i] := 0;
    l[n+1,i] := 0;
    l[i,0] := 0;
    l[i,n+1] := 0;
  end;
 
  for i :=1 to n do
    for j :=1  to n do
      ok[i,j] := true;
 
  for h := 1 to 26 do
  begin
    for i := 1 to n do
      for j := 1 to n do
        if a[i,j] = h then
          l[i,j] := l[i-1,j] + l[i,j-1] - l[i-1,j-1] + 1
        else
          l[i,j] := l[i-1,j] + l[i,j-1] - l[i-1,j-1] ;
 
 
    for i := 1 to n-m+1 do
      for j := 1 to n-m+1 do
      begin
        if ok[i,j] then
          if s[h] <> l[i+m-1,j+m-1] - l[i-1,j+m-1] - l[i+m-1,j-1] + l[i-1,j-1] then
            ok[i,j] := false;
      end;
 
  end;
 
  cont := 0;
  for i := 1 to n-m+1 do
  begin
    for j := 1 to n-m+1 do
    begin
      if ok[i,j] then inc(cont);
    end;
  end;
 
  writeln(cont);
 
  close(input);
  close(output);