Cod sursa(job #1144434)

Utilizator atatomirTatomir Alex atatomir Data 17 martie 2014 08:47:53
Problema Matrix Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.57 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.