PTREE - Cây P đỉnh ( Cơ bản )

Tác giả: flashmt

Ngôn ngữ: Pascal

uses math;
const fi='';
      maxn=210;
var n,p,re:longint;
    a:array[1..maxn*2] of longint;
    pos,cur,sl,c,cha:array[1..maxn] of longint;
    b:array[1..maxn,0..1] of longint;
    f,tr:array[1..maxn,0..maxn] of longint;

procedure rf;
var i:longint;
begin
     read(n,p);
     for i:=1 to n do read(c[i]);
     for i:=1 to n-1 do
     begin
          read(b[i,0],b[i,1]);
          inc(sl[b[i,0]]); inc(sl[b[i,1]]);
     end;
     pos[1]:=1; cur[1]:=1;
     for i:=2 to n+1 do
     begin
          pos[i]:=pos[i-1]+sl[i-1];
          cur[i]:=pos[i];
     end;
     for i:=1 to n-1 do
     begin
          a[cur[b[i,0]]]:=b[i,1];
          inc(cur[b[i,0]]);
          a[cur[b[i,1]]]:=b[i,0];
          inc(cur[b[i,1]]);
     end;
end;

procedure visit(x,y:longint);
var i,j,k:longint;
begin
     cha[x]:=y;
     f[x,1]:=c[x];
     for i:=pos[x] to pos[x+1]-1 do
         if a[i]<>y then
         begin
              visit(a[i],x);
              for j:=p downto 2 do
                  for k:=1 to j-1 do
                      if f[x,j]<f[x,j-k]+f[a[i],k] then
                      begin
                           f[x,j]:=f[x,j-k]+f[a[i],k];
                           tr[a[i],j]:=k;
                      end;
         end;
end;

procedure trace(x,p:longint);
var i,j,k,val:longint;
begin
     write(x,' ');
     for i:=pos[x+1]-1 downto pos[x] do
         if (a[i]<>cha[x]) and (tr[a[i],p]>0) then
         begin
              trace(a[i],tr[a[i],p]);
              p:=p-tr[a[i],p];
         end;
end;

procedure pr;
var i,j,x:longint;
begin
     for i:=1 to n do
         for j:=1 to p do
             f[i,j]:=-1000000;
     visit(1,0);
     for i:=1 to n do
         if f[i,p]>re then
         begin
              re:=f[i,p];
              x:=i;
         end;
     trace(x,p);
end;

begin
     assign(input,fi); reset(input);
     rf;
     pr;
     close(input);
end.

Download