TASK: ditch
LANG: PASCAL
Compiling...
Compile: OK
Executing...
Test 1: TEST OK [0.011 secs, 364 KB]
Test 2: TEST OK [0.000 secs, 364 KB]
Test 3: TEST OK [0.000 secs, 368 KB]
Test 4: TEST OK [0.000 secs, 368 KB]
Test 5: TEST OK [0.000 secs, 368 KB]
Test 6: TEST OK [0.011 secs, 364 KB]
Test 7: TEST OK [0.011 secs, 364 KB]
Test 8: TEST OK [0.000 secs, 364 KB]
Test 9: TEST OK [0.000 secs, 364 KB]
Test 10: TEST OK [0.000 secs, 368 KB]
Test 11: TEST OK [0.000 secs, 364 KB]
Test 12: TEST OK [0.000 secs, 368 KB]
All tests OK.
Your program ('ditch') produced all correct answers! This is your
submission #5 for this problem. Congratulations!
{
ID:cxj6661
PROB:ditch
LANG:PASCAL
}
//By Ceeji
//Date: 2009-4-18
//Type: Network Flow
//Source: Ditch
//State: Programming
Program ditch;
Const
maxn=200;
fin='ditch.in';
fou='ditch.out';
Var
m,n,i,p,q,ci,ans,j:longint;
c:array[1..maxn,1..maxn]of longint;
f,a,d:array[1..maxn]of longint;
b:array[1..maxn]of boolean;
Function min(a,b:longint):longint;
begin
if a>b then exit(b) else exit(a);
end;
Procedure init;
begin
assign(input,fin); reset(input);
assign(output,fou); rewrite(output);
fillchar(c,sizeof(c),0);
readln(n,m);
for i:=1 to n do
begin
readln(p,q,ci);
inc(c[p,q],ci);
end;
close(input);
ans:=0;
end;
Function doit:boolean;
var i,k:longint;
begin
i:=1; j:=2; d[1]:=1;
fillchar(f,sizeof(f),0);
fillchar(b,sizeof(b),0);
a[1]:=maxlongint;
f[1]:=0;
repeat
for k:=1 to m do
begin
if (c[d[i],k]>0)and(b[k]=false) then
begin
d[j]:=k;
f[j]:=i;
a[j]:=min(a[i],c[d[i],k]);
b[k]:=true;
inc(j);
if k=m then exit(true);
end;
end;
inc(i);
until i>=j;
exit(false);
end;
Procedure doit2;
var i,k:longint;
begin
i:=j-1;
while i<>1 do
begin
dec(c[d[f[i]],d[i]],a[j-1]);
inc(c[d[i],d[f[i]]],a[j-1]);
i:=f[i];
end;
inc(ans,a[j-1]);
end;
begin
init;
while doit do doit2;
writeln(ans);
close(output);
end.