ac1053.pas

同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料

program tju1053;
const
  maxn=20;
  maxl=20;
  maxscore=8000;
var
  name,fname:array[0..maxn]of string;
  father,levels,nowlevel:array[0..maxn]of byte;
  point:array[0..maxn,1..maxl]of cardinal;
  score:array[0..maxn,1..maxl]of byte;
  cost:array[0..maxn,0..maxscore]of cardinal;
  mscore:array[0..maxn]of word;
  n,points,i,j:cardinal;
function init(x:byte):word;
  var
    i:word;
  begin
    init:=0;
    for i:=1 to n do
      if father[i]=x then
        inc(init,init(i));
    for i:=nowlevel[x]+1 to levels[x] do
      inc(init,score[x,i]);
    for i:=0 to init do
      cost[x,i]:=maxlongint;
  end;
procedure cal(x:byte);
  var
    i,j,k,t:cardinal;
  begin
    cost[x,0]:=0;mscore[x]:=0;t:=0;
    for i:=nowlevel[x]+1 to levels[x] do begin
      inc(mscore[x],score[x,i]);inc(t,point[x,i]);
      if t<cost[x,mscore[x]] then cost[x,mscore[x]]:=t;
    end;
    for i:=1 to n do
      if father[i]=x then begin
        cal(i);
        for j:=mscore[x] downto ord(nowlevel[x]=0) do
          if cost[x,j]<maxlongint then
            for k:=0 to mscore[i] do begin
              t:=cost[x,j]+cost[i,k];
              if t<cost[x,j+k] then cost[x,j+k]:=t;
            end;
        inc(mscore[x],mscore[i]);
      end;
  end;
begin
  name[0]:='None';levels[0]:=1;nowlevel[0]:=1;
  repeat
    readln(n);
    for i:=1 to n do begin
      readln(name[i]);
      readln(fname[i]);
      read(levels[i]);
      for j:=1 to levels[i] do read(point[i,j]);
      for j:=1 to levels[i] do read(score[i,j]);
      readln;
    end;
    read(points);
    for i:=1 to n do read(nowlevel[i]);
    for i:=1 to n do
      for j:=0 to n do
        if fname[i]=name[j] then begin
          father[i]:=j;
          break;
        end;

    j:=init(0);//The value is useless
    cal(0);
    for i:=mscore[0] downto 0 do
      if cost[0,i]<=points then begin
        writeln(i);
        break;
      end;
  until seekeof;
end.