Cod sursa(job #1374435)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 5 martie 2015 09:16:15
Problema Problema Damelor Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.06 kb
program drumuri1;
var     f,g:text;
        kk,i,j,k,n,nr:longint;
        a:array[0..301,0..301] of integer;
        aa:array[0..90001,0..4] of longint;
        cd,v,gr:array[1..90001] of longint;

procedure bf(nod:longint);
var       st,sf,z,i,j:longint;
begin
  st:=1; sf:=1; cd[st]:=nod;
  while st<=sf do
    begin
      z:=cd[st];
      for i:=1 to aa[z,0] do
        begin
          inc(sf);
          cd[sf]:=aa[z,i];
        end;
      if aa[z,0]>1 then nr:=nr+aa[z,0]-1;
      inc(st);
    end;
end;

begin
  assign(f,'drumuri1.in'); reset(f);
  assign(g,'drumuri1.out'); rewrite(g);
  readln(f,n);
  for i:=1 to n do
    begin
      for j:=1 to n do
        read(f,a[i,j]);
      readln(f);
    end;
  for i:=0 to n+1 do
    begin
      a[0,i]:=-1; a[n+1,i]:=-1;
      a[i,0]:=-1; a[i,n+1]:=-1;
    end;
  for i:=1 to n do
    for j:=1 to n do
      begin
        if a[i,j]<a[i-1,j] then
          begin
            k:=(i-1)*n+j;
            kk:=(i-2)*n+j;
            inc(aa[k,0]);
            aa[k,aa[k,0]]:=kk;
            inc(gr[kk]);
          end;
        if a[i,j]<a[i+1,j] then
          begin
            k:=(i-1)*n+j;
            kk:=i*n+j;
            inc(aa[k,0]);
            aa[k,aa[k,0]]:=kk;
            inc(gr[kk]);
          end;
        if a[i,j]<a[i,j-1] then
          begin
            k:=(i-1)*n+j;
            kk:=(i-1)*n+j-1;
            inc(aa[k,0]);
            aa[k,aa[k,0]]:=kk;
            inc(gr[kk]);
          end;
        if a[i,j]<a[i,j+1] then
          begin
            k:=(i-1)*n+j;
            kk:=(i-1)*n+j+1;
            inc(aa[k,0]);
            aa[k,aa[k,0]]:=kk;
            inc(gr[kk]);
          end;
      end;
  k:=0;
  for i:=1 to  n*n do
    if gr[i]=0 then
      begin
        inc(k);
        v[k]:=i;
      end;
  nr:=0;
  for i:=1 to k do
    begin
      nr:=nr+1;
      bf(v[i]);
    end;
  writeln(g,nr);
  {for i:=1 to n*n do
    begin
      for j:=1 to aa[i,0] do
        write(aa[i,j],' ');
      writeln;
    end;}
  close(f); close(g);
end.