Cod sursa(job #180214)

Utilizator h_istvanHevele Istvan h_istvan Data 16 aprilie 2008 19:26:11
Problema Castel Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.26 kb
program castel;
type pElem = ^elem;
     elem = record
            x:word;
            kov:pElem;
            end;
const max = 22500;
var f:text;
    qb,qe,e,n,m,k,i,j,x,y:word;
    temp:pElem;
    v:array[1..max] of word; {v[i] az i szobahoz valo kulcs szama}
    q:array[1..max] of word; {queue}
    list:array[1..2,1..max] of pElem;
    bejart,inlist:array[1..max] of boolean; {bejart[i] = 1 ha jartunk az i.szobaban, kulonben 0}


procedure addList(x,y:word);
var t:pElem;
begin
     if(list[1,x] = nil) then
     begin
          new(list[1,x]);
          list[1,x]^.x:=y;
          list[1,x]^.kov:=nil;
          list[2,x]:=list[1,x];
     end else
     begin
          new(t);
          t^.x:=y;
          t^.kov:=nil;
          list[2,x]^.kov:=t;
          list[2,x]:=t;
     end;
end;

begin
     assign(f,'castel.in');
     reset(f);
     readln(f,n,m,k);
     for i:=1 to n do
     begin
          for j:=1 to m do
              read(f,v[(i-1)*m+j]);
          readln(f);
     end;
     close(f);

     qb:=1;qe:=1;
     q[1]:=k;
     bejart[k]:=true;
     e:=1;

     while(qb<=qe) do
     begin
          temp:=list[1,q[qb]];
          while(temp <> nil) do
          begin
               if not(bejart[temp^.x]) then
               begin
                    inc(e);
                    bejart[temp^.x]:=true;
                    inc(qe);
                    q[qe]:=temp^.x;
               end;
               temp:=temp^.kov;
          end;

          x:=(q[qb]-1) div m+1;
          y:=(q[qb]-1) mod m+1;
          if(x<n) and not bejart[q[qb]+m] then
          begin
               if (bejart[v[q[qb]+m]]) then
               begin
                    inc(e);
                    bejart[q[qb]+m]:=true;
                    inc(qe);
                    q[qe]:=q[qb]+m;
               end else
               begin
                    addlist(v[q[qb]+m],q[qb]+m);
               end;
          end;
          if(x>1) and not bejart[q[qb]-m] then
          begin
               if (bejart[v[q[qb]-m]]) then
               begin
                    inc(e);
                    bejart[q[qb]-m]:=true;
                    inc(qe);
                    q[qe]:=q[qb]-m;
               end else
               begin
                    addlist(v[q[qb]-m],q[qb]-m);
               end;
          end;
          if(y<m) and not bejart[q[qb]+1] then
          begin
               if (bejart[v[q[qb]+1]]) then
               begin
                    inc(e);
                    bejart[q[qb]+1]:=true;
                    inc(qe);
                    q[qe]:=q[qb]+1;
               end else
               begin
                    addlist(v[q[qb]+1],q[qb]+1);
               end;
          end;
          if(y>1) and not bejart[q[qb]-1] then
          begin
               if (bejart[v[q[qb]-1]]) then
               begin
                    inc(e);
                    bejart[q[qb]-1]:=true;
                    inc(qe);
                    q[qe]:=q[qb]-1;
               end else
               begin
                    addlist(v[q[qb]-1],q[qb]-1);
               end;
          end;
          inc(qb);
     end;

     assign(f,'castel.out');
     rewrite(f);
     writeln(f,e);
     close(f);
end.