Cod sursa(job #153980)

Utilizator ProtomanAndrei Purice Protoman Data 10 martie 2008 20:52:53
Problema Dosare Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.22 kb
type point=^nod;
     nod=record
         nr:longint;
         ua:point;
     end;

var f1,f2:text;
    i,n,st,t:longint;
    l:array[0..16010] of point;
    a,d:array[0..16010] of longint;

procedure pozitie(var m:longint; p,u:longint);
var i,j,di,dj,aux:longint;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
        begin
                if d[a[i]]<d[a[j]] then
                begin
                        aux:=a[i];
                        a[i]:=a[j];
                        a[j]:=aux;
                        aux:=di;
                        di:=-dj;
                        dj:=-aux;
                end;
                i:=i+di;
                j:=j+dj;
        end;
        m:=i;
end;

procedure quick(p,u:longint);
var m:longint;
begin
        if p<u then
        begin
                pozitie(m,p,u);
                quick(p,m-1);
                quick(m+1,u);
        end;
end;

procedure aranj(nod:longint);
var p,s,el:point;
    i,j:longint;
begin
        p:=l[nod];
        el:=nil;
        while p<>nil do
        begin
                l[nod]:=p;
                p:=l[nod]^.ua;
                aranj(l[nod]^.nr);
                new(s);
                s^.nr:=l[nod]^.nr;
                s^.ua:=el;
                el:=s;
                dispose(l[nod]);
        end;
        s:=el;
        i:=0;
        while s<>nil do
        begin
                el:=s;
                s:=el^.ua;
                inc(i);
                a[i]:=el^.nr;
                dispose(el);
        end;
        j:=i;
        quick(1,j);
        for i:=1 to 1 do
                d[nod]:=d[nod]+(i-1)*d[a[i]]+1;
end;

procedure clad(t,f:longint);
var p:point;
begin
        new(p);
        p^.nr:=f;
        p^.ua:=l[t];
        l[t]:=p;
end;

begin
        assign(f1,'dosare.in');
        reset(f1);
        assign(f2,'dosare.out');
        rewrite(f2);
        read(f1,n);
        for i:=1 to n-1 do
        begin
                read(f1,t);
                clad(t,i+1);
        end;
        for i:=1 to n do
                read(f1,d[i]);
        aranj(1);
        writeln(f2,d[1]);
        close(f1);
        close(f2);
end.