Cod sursa(job #680439)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 15 februarie 2012 16:59:43
Problema Cerere Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.17 kb
type muchie = ^nod;
     nod=record n:longint; a:muchie; end;

var v:array [0..20, 0..100000] of longint;  //optimizarea vectorului de tati
    w1:array[1..100000] of longint;         //vectorul de sarituri
    r:array [1..100000] of longint;         //raspunsul
    vv:array[1..100000] of muchie;          //reprezentarea pentru dfs
    jmen1, jmen2:int64;
    i, j, n, m, x, y, z, t:longint;
    f, g:text;
    p:muchie;
    ok:boolean;
    c:char;
    buf1, buf2:array [1.. 1 shl 17] of char;

function cauta (fp:longint):longint;
var fy, fx, fj:longint;
  begin

  if w1[fp]=0 then cauta:=0 else
    begin
    if r[fp]<>0 then cauta:=r[fp] else
      begin
      fx:=fp; fy:=w1[fp];

      fj:=1;
      while (fx<>0) and (fy<>0) do
        begin
        while fy mod 2 = 0 do
          begin
          fy := fy div 2;
          inc (fj);
          end;

        fx:=v[fj, fx];
        fy:=fy div 2; inc (fj);
        end;

      r[fp]:=1+cauta(fx);
      cauta:=r[fp];
      end;
    end;
  end;

procedure dfs(fx:longint);
var fp:muchie;
    f1, f2, fj:longint;
  begin
  fp:=vv[fx];
  if w1[fx]<>0 then
    begin
    f1:=fx; f2:=w1[fx]; fj:=1;
    while (f1<>0) and (f2<>0) do
      begin
      while f2 mod 2 = 0 do
        begin
        f2 := f2 div 2;
        inc (fj);
        end;
      f1:=v[fj, f1];
      f2:=f2 div 2; inc (fj);
      end;

    r[fx]:=1+r[f1];
    end;

  while fp <> nil do begin dfs(fp^.n); fp:=fp^.a; end;
  end;

begin
assign (f, 'cerere.in'); settextbuf (f, buf1); reset (f);
assign (g, 'cerere.out'); settextbuf (g, buf2); rewrite (g);

readln (f, n);

for i:= 1 to n do read (f, w1[i]);
for i := 1 to n-1 do
  begin
  read (f, x, y);
  v[1, y]:=x;
  new(p); p^.n:=y; p^.a:=vv[x]; vv[x]:=p;
  jmen1:=jmen1+y;
  end;

// initializarea dinamicii
ok:=true; i:=1;
while ok do
  begin
  ok:=false;
  for j := 1 to n do
    begin
    if v[i, j]<>0 then
      begin
      v[i+1, j]:=v[i, v[i, j]];
      if v[i+1, j] <> 0 then ok:=true;
      end;
    end;

  inc (i);
  end;

jmen2:=(n*n+n) div 2 - jmen1;
dfs (jmen2);

for i := 1 to n do write (g, r[i], ' ');
close (f); close (g);
end.