Cod sursa(job #303908)

Utilizator punkistBarbulescu Dan punkist Data 10 aprilie 2009 14:51:29
Problema Castel Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.24 kb
var sx,sy,m,n,k,chei:longint;
    cheimax:longint;
    mat:array[1..150,1..150] of record
                                  cx,cy:byte;
                                end;
    viz:array[1..150,1..150] of boolean;
    trl:array[1..150,1..150] of boolean;

procedure Citeste;
var f:text;
    i,j,a:longint;
begin
assign(f,'castel.in');
reset(f);
readln(f,m,n,k);
for i:=1 to m do
 begin
  for j:=1 to n do
   begin
    read(f,a);
    mat[i,j].cx:=a div n+1;
    mat[i,j].cy:=a mod n;
    if mat[i,j].cy=0 then
     begin
      mat[i,j].cy:=n;
      mat[i,j].cx:=mat[i,j].cx-1;
     end;
    viz[i,j]:=false;
    trl[i,j]:=false;
   end;
 end;
close(f);
sy:=k mod n;
sx:=k div n+1;
if sy=0 then
 begin
  sy:=n;
  sx:=sx-1;
 end;
chei:=0;
end;

function Posibil(x,y:byte):boolean;
 var xc,yc:longint;
     e:boolean;
 begin
  e:=false;
  if (x>0) and (y>0) and (x<=m) and (y<=n) then
   if not viz[x,y] then
   begin
    trl[x,y]:=true;
    if viz[mat[x,y].cx,mat[x,y].cy] then
     e:=true;
    end;
  Posibil:=e;
 end;

procedure Parcurge;
 const SizeC = 250000;
 var nrC,inC,sfC:longint;
     C:array[1..SizeC] of record
                            x,y:byte;
                           end;
     i,j,x,y:byte;

 procedure Mergi(a,b:byte);
  begin
   sfC:=sfC+1;
   if SfC>SizeC then
    SfC:=1;
   nrC:=nrC+1;
   C[sfC].x:=a; C[sfC].y:=b;
  end;

 begin
  inC:=1; sfC:=1; nrC:=1;
  C[1].x:=sx; C[1].y:=sy;
  while (inC<=sfC) or (nrC>0) do
   begin
    x:=C[inC].x; y:=C[inC].y;
    if viz[x,y]=false then chei:=chei+1;
    viz[x,y]:=true;
    if Posibil(x-1,y) then Mergi(x-1,y);
    if Posibil(x+1,y) then Mergi(x+1,y);
    if Posibil(x,y-1) then Mergi(x,y-1);
    if Posibil(x,y+1) then Mergi(x,y+1);
    inC:=inC+1;
    if inC > SizeC then inC:=1;
    nrC:=nrC-1;
    if nrC<1 then
     begin
      for i:=1 to m do
       begin
        for j:=1 to n do
         begin
          if (trl[i,j]) then
           if Posibil(i,j) then
            Mergi(i,j);
         end;
       end;
     end;
   end;
 end;

procedure Scrie;
 var i,j:longint;
     f:text;
 begin
  assign(f,'castel.out');
  rewrite(f);
  writeln(f,chei);
  close(f);
 end;

begin
Citeste;
Parcurge;
Scrie;
end.