【NOI2008】 奥运物流

奥运物流
【问题描述】
2008 北京奥运会即将开幕,
举国上下都在为这一盛事做好准备。
为了高效率、
成功地举办奥运会,对物流系统进行规划是必不可少的。
物流系统由若干物流基站组成,以 1...N 进行编号。每个物流基站 i 都有且
仅有一个后继基站 Si,而可以有多个前驱基站。基站 i 中需要继续运输的物资都
将被运往后继基站 Si,显然一个物流基站的后继基站不能是其本身。编号为 1 的
从任何物流基站都可将物资运往控制基站。
注意控制基
物流基站称为控制基站,
站也有后继基站,以便在需要时进行物资的流通。在物流系统中,高可靠性与低
成本是主要设计目。对于基站 i,我们定义其“可靠性” R (i ) 如下:
设物流基站 i 有 w 个前驱基站 P1, P2 ,Pw ,即这些基站以 i 为后继基站,则基站 i 的可靠性 R(i)满足下式:w
R(i ) = Ci + k ∑ R( Pj )j =1
其中 Ci 和 k 都是常实数且恒为正,且有 k 小于 1。
整个系统的可靠性与控制基站的可靠性正相关,
我们的目标是通过修改物流系统,即更改某些基站的后继基站,使得控制基站的可靠性 R(1)尽量大。但由于经费限制,最多只能修改 m 个基站的后继基站,并且,控制基站的后继基站不可被修改。因而我们所面临的问题就是,如何修改不超过 m 个基站的后继,使
得控制基站的可靠性 R(1)最大化。
【输入格式】
输入文件 trans.in 第一行包含两个整数与一个实数,N, m, k。其中 N 表示基
站数目,m 表示最多可修改的后继基站数目,k 分别为可靠性定义中的常数。
第二行包含 N 个整数,分别是 S1, S2...SN,即每一个基站的后继基站编号。
第三行包含 N 个正实数,分别是 C1, C2...CN,为可靠性定义中的常数。
【输出格式】
输出文件 trans.out 仅包含一个实数,为可得到的最大 R(1)。精确到小数点两
位。
【输入样例】
4 1 0.5
2313
10.0 10.0 10.0 10.0
【输出样例】
30.00
【样例说明】
原有物流系统如左图所示,4 个物流基站的可靠性依次为 22.8571,21.4286,
25.7143,10。
最优方案为将 2 号基站的后继基站改为 1 号,如右图所示。 此时 4 个基站
的可靠性依次为 30,25,15,10。
【数据规模和约定】
本题的数据,具有如下分布:
测试数据编号            N                              M
1                               ≤6                             ≤6
2                               ≤ 12                          ≤ 12
3                               ≤ 60                           0
4                               ≤ 60                           1
5                               ≤ 60                          N-2
6~10                         ≤ 60                          ≤ 60
对于所有的数据,满足 m ≤ N ≤ 60,Ci ≤ 106,0.3 ≤ k < 1,请使用双精度实
数,无需考虑由此带来的误差。

 

题解

 

(*
    *Problem:    NOI2008 奥运物流
    *Author :    Chen Yang
    *Time   :    2012.5.20
    *State  :    70分
    *Memo    :    贪心
*)
program trans;
type
  ty1=^ty2;
  ty2=record
     x:longint;
     next:ty1;
  end;
var
  n,m,i:longint;
  k,ans:extended;
  father:array[0..100] of longint;
  c,r:array[0..100] of extended;
  get:array[0..100] of boolean;
  first:array[0..100] of ty1;
//=====================
procedure insert(x,y:longint);
var
  p:ty1;
begin
  new(p);
  p^.x:=y;
  p^.next:=first[x];
  first[x]:=p;
end;
//=====================
procedure find(i:longint; kx:extended);
var
  p:ty1;
  x:extended;
  son:longint;
begin
  p:=first[i]; x:=0; son:=0;
  while p<>nil do
  begin
    if not get[p^.x] then
    begin
      find(p^.x,kx);
      x:=x+r[p^.x];
    end else son:=p^.x;
    p:=p^.next;
  end;
  if not get[i] then r[i]:=x*k+c[i] else ans:=ans+c[i]*kx+x*kx*k;
  if son>0 then find(son,kx*k);
end;
//=====================
procedure work;
var
  i,t:longint;
  kx:extended;
begin
  fillchar(first,sizeof(first),0);
  fillchar(get,sizeof(get),false);
  for i:=2 to n do insert(father[i],i);
  ans:=0; t:=0;
  i:=1;
  while father[i]<>1 do
  begin
    inc(t);
    get[i]:=true;
    i:=father[i];
  end;
  get[i]:=true; inc(t);
  find(1,1);
  kx:=1;
  for i:=1 to t do kx:=kx*k;
  ans:=ans/(1-kx);
end;
//=====================
procedure main;
var
  i,t,k,j:longint;
begin
  work; r[1]:=ans;
  if m=0 then writeln(ans:0:2) else
  if m=n-2 then
  begin
    for i:=2 to n do father[i]:=1;
    work;
    writeln(ans:0:2);
  end else
  begin
    for j:=1 to m do
    begin
      k:=0;
      for i:=2 to n do
      if father[i]<>1 then
      begin
        t:=father[i]; father[i]:=1;
        work;
        if r[1]<ans then begin r[1]:=ans; k:=i; end;
        father[i]:=t;
      end;
      father[k]:=1;
    end;
    writeln(r[1]:0:2);
  end;
end;
//=====================
begin
  assign(input,'trans.in'); reset(input);
  assign(output,'trans.out'); rewrite(output);
  read(n,m,k);
  for i:=1 to n do read(father[i]);
  for i:=1 to n do read(c[i]);
  main;
  close(input); close(output);
end.

 

(*
    *Problem:    NOI2008 奥运物流
    *Author :    Chen Yang
    *Time   :    2012.5.20
    *State  :    AC
    *Memo    :    树形DP，多重背包
*)
program trans;
uses math;
const maxn=65;
var
  n,m,i,len:longint;
  k,ans:extended;
  fa:array[0..maxn] of longint;
  c,kk,ff:array[0..maxn] of extended;
  f,g:array[0..maxn,0..maxn,0..maxn] of extended;
//==================
procedure find(x,d:longint);
var
  i,j,k,l:longint;
begin
  for i:=2 to n do if fa[i]=x then find(i,d+1);
  for k:=min(2,d) to d do
  begin
    for i:=0 to m do ff[i]:=0;
    for i:=2 to n do if fa[i]=x then
    for j:=m downto 0 do
    for l:=j downto 0 do
    if ff[j]<ff[l]+g[i,j-l,k] then ff[j]:=ff[l]+g[i,j-l,k];
    for i:=0 to m do f[x,i,k]:=ff[i]+kk[k]*c[x];
  end;
  if d<>1 then
  begin
    for i:=0 to m do ff[i]:=0;
    for i:=2 to n do if fa[i]=x then
    for j:=m downto 0 do
    for l:=j downto 0 do
    if ff[j]<ff[l]+g[i,j-l,1] then ff[j]:=ff[l]+g[i,j-l,1];
    for i:=1 to m do f[x,i,1]:=ff[i-1]+kk[1]*c[x];
  end;
  for j:=0 to m do
  for k:=0 to d-1 do
  if f[x,j,k+1]>f[x,j,1] then g[x,j,k]:=f[x,j,k+1] else g[x,j,k]:=f[x,j,1];
end;
//==================
procedure work(father:longint);
var
  i,j,k:longint;
  t:extended;
begin
  fillchar(f,sizeof(f),0);
  fillchar(g,sizeof(g),0);
  for i:=2 to n do if fa[i]=1 then find(i,1);
  for i:=0 to m do ff[i]:=0;
  for i:=2 to n do if fa[i]=1 then
  for j:=m downto 0 do
  for k:=j downto 0 do
  if ff[j]<ff[k]+f[i,j-k,1] then
  ff[j]:=ff[k]+f[i,j-k,1];
  t:=0;
  for i:=0 to m-1 do
  if t<ff[i] then t:=ff[i];
  if (father=1)and(ff[m]>t) then t:=ff[m];
  t:=(t+c[1])/(1-kk[len]);
  if ans<t then ans:=t;
end;
//==================
procedure main;
var
  i,t:longint;
begin
  kk[0]:=1; for i:=1 to n do kk[i]:=kk[i-1]*k;
  i:=fa[1]; len:=1;
  while i<>1 do
  begin
    inc(len); t:=fa[i]; fa[i]:=1;
    work(t);
    fa[i]:=t; i:=t;
  end;
  writeln(ans:0:2);
end;
//==================
begin
  assign(input,'trans.in'); reset(input);
  assign(output,'trans.out'); rewrite(output);
  read(n,m,k);
  for i:=1 to n do read(fa[i]);
  for i:=1 to n do read(c[i]);
  main;
  close(input); close(output);
end.