Cod sursa(job #121720)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 9 ianuarie 2008 16:03:31
Problema Dosare Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.86 kb
var m:array[0..16000,0..13000]of longint;
    v,c,a,p:array[0..16009]of longint;
    n,i,j,k:longint;
    s:int64;
    f:text;
{procedure merg(p,r:longint);
var x,y:array[1..16000]of longint;
    q,u:longint;
begin
   q:=(p+r)div 2;
   if(q>p)then merge(p,q);
   if(r>q+1)then merge(q+1,r);
   for u:=p to
                }
procedure dosar(x:longint);
var b:longint;
begin
   for b:=1 to c[x] do
   begin
   dosar(m[x,b]);
   v[x]:=v[x]+v[m[x,b]];
   end;
end;
procedure merge(w,p,r:longint);
var x,y:array[1..16000]of longint;
    q,u,c,d,e:longint;
begin
   q:=(p+r)div 2;
   if q>p then merge(w,p,q);
   if r>q+1 then merge(w,q+1,r);
   for u:=p to q do
   x[u]:=m[w,u];
   for u:=q+1 to r do
   y[u]:=m[w,u];
   c:=p;
   d:=q+1;
   e:=p;
   while(c<=q)and(d<=r)do
   if v[x[c]]>v[y[d]]then begin m[w,e]:=x[c];
                                e:=e+1;
                                c:=c+1;
                          end
                     else begin m[w,e]:=y[d];
                                e:=e+1;
                                d:=d+1;
                          end;
   if c<=q then for u:=e to r do
                begin
                m[w,u]:=x[c];
                c:=c+1;
                end
           else for u:=e to r do
                begin
                m[w,u]:=y[d];
                d:=d+1;
                end;
end;
begin
   assign(f,'dosare.in');
   reset(f);
   read(f,n);
   for i:=2 to n do
   begin
   v[i]:=1;
   read(f,k);
   c[k]:=c[k]+1;
   m[k,c[k]]:=i;
   end;
   for i:=1 to n do
   begin
   read(f,a[i]);
   v[i]:=a[i];
   end;
   close(f);
   dosar(1);
   for i:=1 to n do
   if c[i]>1 then merge(i,1,c[i]);
   m[0,1]:=1;
   c[0]:=1;
   for i:=0 to n do
   for j:=1 to c[i] do
   s:=s+v[m[i,j]]*j;
   assign(f,'dosare.out');
   rewrite(f);
   writeln(f,s);
   close(f);
end.