Cod sursa(job #254324)

Utilizator lianaliana tucar liana Data 7 februarie 2009 11:12:11
Problema Kdrum Scor 20
Compilator fpc Status done
Runda Stelele Informaticii 2009, clasele 9-10, ziua 2 Marime 1.85 kb
Const MaxS=77;
      Infinit=40000;
Var
  I,J,N,M,k: LongInt;
  P: Array[0..MaxS+1, 0..MaxS+1] Of longint;
  Dist: Array[0..MaxS+1,0..MaxS+1]Of Word;
  Queue: Array[0..(MaxS+2)*(MaxS+2)] Of Record X,Y:ShortInt; End;
  X1,Y1,X2,Y2: Longint;
  fin, fout: text;

Procedure Solve;
Var Sf,IncC: LongInt; NX,NY,CX,CY: LongInt;
Begin
  For CX:=0 To N+1 Do
    For CY:=0 To M+1 Do
        Dist[CX,CY]:=Infinit;
  Queue[0].X:=X1; Queue[0].Y:=Y1;  Dist[X1,Y1]:=0;
  Sf:=0; IncC:=0;
  While IncC<=Sf Do
        Begin
        CX:=Queue[IncC].X; CY:=Queue[IncC].Y;
        Inc(IncC);
        For NX:=CX-1 To CX+1 Do
            If (NX>0) And (NX<N+1) Then
               For NY:=CY-1 To CY+1 Do
                   If (NY>0) And (NY<M+1) Then
                      If Abs(NX-CX)+Abs(NY-CY)=1 Then
                         If P[NX,NY]<>-1 Then
                            If Dist[NX,NY]=Infinit Then
                               Begin
                               Dist[NX,NY]:=Dist[CX,CY]+1;
                               Inc(Sf);
			       Queue[Sf].X:=NX; Queue[Sf].Y:=NY;
                               End;
        End;
  If Dist[X2,Y2]<Infinit Then WriteLn(fout,Dist[X2,Y2]+1)
     Else WriteLn(fout,0);
  for i:=1 to n do
    begin
      for j:=1 to m do
        write(dist[i,j],' ');
      writeln;
    end;
End;

Begin
  Assign(fin,'kdrum.in'); ReSet(fin);
  Readln(fin, N, M,k);
  for i:=0 to N+1 do
      begin
      P[i,0]:=-1;
      P[i,M+1]:=-1;
      end;
  for i:=0 to M+1 do
      begin
      P[0,i]:=-1;
      P[N+1,i]:=-1;
      end;
  Assign(fout,'kdrum.out');ReWrite(fout);
  Readln(fin, X1, Y1, X2, Y2);
  For I:=1 To N Do
      begin
      For J:=1 To M Do
        begin
          read(fin,P[i,j]);
          if p[i,j]=0 then
            p[i,j]:=-1;
        end;
      end;
  Solve;
  Close(fin); Close(fout);
End.