Cod sursa(job #151577)

Utilizator ghitza_2000Stefan Gheorghe ghitza_2000 Data 8 martie 2008 13:44:47
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.06 kb
    type adr1=^nod1;
         nod1 = record
         inf:longint;
         adr:adr1;
         end;

         adr2=^nod2;
         nod2 = record
         poz,inf:longint;
        adr:adr2;
       end;

  var  n,m,rad:longint;
       t,st:array[1..250000] of longint;
       rez:array[1..300000] of longint;
       vc:array[1..250000] of adr1;
       qr:array[1..250000] of adr2;

  procedure citire;
          var f:text;
              i,ta,fi,qu:longint;
              q:adr1;
              q2:adr2;
          begin
          assign(f,'stramosi.in'); reset(f);
          readln(f,n,m);
          for i:=1 to n do begin vc[i]:=nil; qr[i]:=nil; end;
          for i:=1 to n do
           begin
           read(f,ta);
           if ta<>0 then
                 begin
                  t[i]:=1;
                  new(q);
                q^.inf:=i;
                  q^.adr:=vc[ta];
                  vc[ta]:=q;
                  end;
           end;
          for i:=1 to m do
              begin
              readln(f,fi,qu);
              new(q2);
              q2^.inf:=qu;
              q2^.poz:=i;
              q2^.adr:=qr[fi];
              qr[fi]:=q2;
              end;
         close(f);
          end;

   procedure df(k,niv:longint);
         var q:adr2;
              v:adr1;
          begin
         st[niv]:=k;
       q:=qr[k];
         while (q<>nil) do
          begin
           if niv<=q^.inf then
           rez[q^.poz]:=0
           else
                  rez[q^.poz]:=st[niv-q^.inf];
           q:=q^.adr;
           end;
          v:=vc[k];
         while v<>nil do
                  begin
               df(v^.inf,niv+1);
                  v:=v^.adr;
                 end;
          end;
   procedure scriere;
          var i:longint;
             f:text;
         begin
       assign(f,'stramosi.out');
          rewrite(f);
      for i:=1 to m do writeln(f,rez[i],' ');
         close(f);

          end;


  begin
 citire;
 for rad:=1 to  n do
   if t[rad]=0 then
         df(rad,1);
  scriere;
 end.