Скачать программы Все программы автора
ВИШНЯ
Маленький, но гордый мышонок решил съесть все ягоды с дерева вишни. Вишня — это обычное дерево, ветки которого разветвляются и не срастаются снова. Из точки, где заканчивается ветка, могут начинаться другие ветки или может расти некоторое количество ягод. Ветки дерева настолько длинные, что силы мышонка заметно истощаются, когда он ползет по веткам. Когда мышонок проползает по ветке один метр, он теряет единицу запаса полезных веществ (ПВ), которые содержатся в его организме. Съедание одной вишни пополняет запас ПВ на единицу. Если запас ПВ становится отрицательным, мышонок погибает.
Задание
Напишите программу CHERRY, которая по информации о дереве определяет минимальное количество единиц ПВ которое мышонок должен иметь, чтобы съесть все ягоды с дерева и вернуться на землю. При этом, на протяжении движения текущий запас ПВ не может быть отрицательным.
Движение всегда начинается и заканчивается в начале ветки с номером 1, которая соответствует стволу.
Входные данные
В первой строке входного файла CHERRY.DAT содержится целое число N (1≤N≤100) — количество веток в дереве. Дальше идут N строк, которые описывают дерево. Каждая (i+1)-ая строка файла задает информацию про i-ую вершину. Первым в строке идет целое число L (1≤L≤30 000), которое задает длину ветки. Вторым — количество веток K, которые начинаются с конца i-ой ветки. Далее следует K чисел — номера этих веток. Если число K для ветки равно нулю, то третье число задает количество ягод V (0≤V≤30 000), которые растут на конце ветки.
Выходные данные
В единственной строке файла CHERRY.SOL должно находится целое число — минимальное количество единиц ПВ, которое должен иметь мышонок, для восхождения на дерево, съедания всех ягод и возвращения на землю.
Пример входных и выходных данных
CHERRY.DAT |
CHERRY.SOL |
8 5 3 6 5 7 5 0 10 9 0 1 4 0 19 11 0 50 5 2 2 4 3 2 8 3 4 0 0 |
15 |
{ Problem: CHERRY}
const
maxN=100;
Inf=-1;
type
EqFunc=function(a,b:longint):shortint;
maxNarr=array[1..maxN] of longint;
var
a,b:maxNarr;
kola,kolb:longint;
e,v,m:array[1..maxN] of longint;
adj,potom:array[1..maxN,1..maxN] of byte;
power:array[1..maxN] of longint;
len,kol:array[1..maxN] of longint;
fi,fo:Text;
N,i,j,k,o,exti:longint;
bestres,curres,S:longint;
aa:array[1..maxN,1..maxN] of longint;
perest:array[1..maxN] of longint;
MM:longint;
label next;
procedure Xch(var x:maxNarr;a,b:longint);
var
temp:longint;
begin
temp:=x[a];
x[a]:=x[b];
x[b]:=temp;
end;
function EqA(a,b:longint):shortint;far;
begin
if m[a]<m[b] then
EqA:=-1
else
if m[a]>m[b] then
EqA:=1
else
EqA:=0;
end;
function EqB(a,b:longint):shortint;far;
begin
if v[a]>v[b] then
EqB:=-1
else
if v[a]<v[b] then
EqB:=1
else
EqB:=0;
end;
procedure Heapify(what:longint;var x:maxNarr;N:longint;Eq:EqFunc);
var
max:longint;
begin
while what*2<=N do
begin
max:=what;
if Eq(x[what*2],x[max])>0 then
max:=what*2;
if (what*2+1<=N)AND
(Eq(x[what*2+1],x[max])>0) then
max:=what*2+1;
if max=what then
what:=N
else
begin
Xch(x,max,what);
what:=max;
end;
end;
end;
procedure Compute(what:longint);
var
i,s:longint;
begin
if power[what]=0 then
begin
{это - если у ветки нету потомков}
if kol[what]>=len[what] then
begin
m[what]:=len[what];
v[what]:=kol[what]-len[what];
end
else
begin
m[what]:=2*len[what]-kol[what];
v[what]:=0;
end;
if kol[what]>0 then
e[what]:=1
else
e[what]:=0;
end
else
begin
{вычисляем m,v,e.
делим на три группы (a,b и те, которые не входят)}
kola:=0;
kolb:=0;
for i:=1 to N do
if (potom[what,i]=1)AND(e[i]=1) then
begin
e[what]:=1;
if v[i]>=m[i] then
begin
Inc(kola);
a[kola]:=i;
end
else
begin
Inc(kolb);
b[kolb]:=i;
end;
end;
{сортируем группу a}
for i:=kola div 2 downto 1 do
Heapify(i,a,kola,EqA);
i:=kola;
while kola>1 do
begin
Xch(a,1,kola);
Dec(kola);
Heapify(1,a,kola,EqA);
end;
kola:=i;
{сортируем группу b}
for i:=kolb div 2 downto 1 do
Heapify(i,b,kolb,EqB);
i:=kolb;
while kolb>1 do
begin
Xch(b,1,kolb);
Dec(kolb);
Heapify(1,b,kolb,EqB);
end;
kolb:=i;
{обход отсортированных потомков}
s:=0;
m[what]:=0;
if e[what]=1 then
begin
s:=s-len[what];
if -s>m[what] then
m[what]:=-s;
for i:=1 to kola do
begin
s:=s-m[a[i]];
if -s>m[what] then
m[what]:=-s;
s:=s+v[a[i]];
end;
for i:=1 to kolb do
begin
s:=s-m[b[i]];
if -s>m[what] then
m[what]:=-s;
s:=s+v[b[i]];
end;
s:=s-len[what];
if -s>m[what] then
m[what]:=-s;
end;
v[what]:=s+m[what];
end;
end;
{обход дерева для вычисления функций}
procedure Dynamic(what:longint);
var
i:longint;
begin
for i:=1 to N do
if potom[what,i]=1 then
Dynamic(i);
Compute(what);
end;
function max(a,b:longint):longint;
begin
if a>b then
max:=a
else
max:=b;
end;
procedure Xch2(a,b:longint);
var
temp:longint;
begin
temp:=perest[a];
perest[a]:=perest[b];
perest[b]:=temp;
end;
procedure Sort(a,b:longint);
var
i,j,min:longint;
begin
for i:=a to b-1 do
begin
min:=i;
for j:=i+1 to b do
if perest[min]>perest[j] then
min:=j;
Xch2(i,min);
end;
end;
begin
assign(fi,'cherry.dat');
reset(fi);
{ввод из файла}
read(fi,N);
fillchar(adj,sizeof(adj),0);
for i:=1 to N do
begin
read(fi,len[i]);
read(fi,power[i]);
if power[i]=0 then
read(fi,kol[i])
else
begin
kol[i]:=0;
for j:=1 to power[i] do
begin
read(fi,k);
for o:=1 to N do
if (potom[i,o]=1) then
begin
adj[k,o]:=1;
adj[o,k]:=1;
end;
potom[i,k]:=1;
adj[i,k]:=1;
adj[k,i]:=1;
end;
end;
end;
close(fi);
Dynamic(1);
for i:=1 to N do
for j:=1 to N do
begin
if i=j then
aa[i,j]:=len[i]
else
if (adj[i,j]=1)OR(adj[j,i]=1) then
aa[i,j]:=len[i]+len[j]
else
aa[i,j]:=Inf;
end;
for k:=1 to N do
for i:=1 to N do
for j:=1 to N do
if (aa[i,k]<>Inf)AND(aa[k,j]<>Inf)AND
((aa[i,j]=Inf)OR(aa[i,j]>aa[i,k]+aa[k,j])) then
aa[i,j]:=aa[i,k]+aa[k,j]-len[k];
MM:=0;
for i:=1 to N do
if kol[i]>0 then
begin
Inc(MM);
perest[MM]:=i;
end;
bestres:=M[1];
assign(fo,'cherry.sol');
rewrite(fo);
repeat
s:=0;
curres:=0;
for i:=1 to MM do
begin
if i=1 then
begin
s:=s-aa[1,perest[1]];
curres:=max(curres,-s);
end
else
begin
s:=s-aa[perest[i-1],perest[i]];
curres:=max(curres,-s);
end;
s:=s+kol[perest[i]];
if (curres>=bestres) then
goto next;
end;
s:=s-aa[perest[MM],1];
curres:=max(curres,-s);
if (curres<bestres) then
begin
bestres:=curres;
end;
next:
if i>MM then
i:=MM;
j:=MM;
while (j>i)AND(perest[j]<=perest[i]) do
Dec(j);
exti:=j;
while (j>i) do
begin
if (perest[j]>perest[i])AND(perest[j]<perest[exti]) then
exti:=j;
Dec(j);
end;
j:=exti;
if exti<=i then
begin
i:=i-1;
while (i>0)AND(perest[i]>perest[i+1]) do
Dec(i);
if i>0 then
begin
j:=i+1;
while (J<=MM)AND(perest[j]>perest[i]) do
Inc(j);
Dec(j);
end;
end;
if i>0 then
begin
Xch2(i,j);
Sort(i+1,MM);
end;
until (i<=0);
writeln(fo,bestres);
close(fo);
end