Listing BOMBOANE.PAS
Program
constmaxn=100;
typelin=array [0..2*maxn+1] of Integer;
plin=^lin;
mat=array [0..2*maxn+1] of plin;
varcap,cost:mat;
n,m,i,j,k,t,sursa,dest,v:Integer;
d,tata:array [0..2*maxn+1] of Integer;
actua:Boolean; f:Text;
procedurealoca;
begin
for i:=0 to dest do
begin
New(cap[i]); New(cost[i]);
for j:=0 to dest do
begin
cap[i]^[j]:=-1; cost[i]^[j]:=maxint
end
end;
for i:=1 to n do
begin
cap[sursa]^[i]:=1;
cost[sursa]^[i]:=0;
cost[i]^[sursa]:=0
end;
for i:=n+1 to 2*n do
begin
cap[i]^[dest]:=1;
cost[i]^[dest]:=0;
cost[dest]^[i]:=0
end
end;
procedureload;
begin
Assign(f,'BOMBON.IN');
Reset(f);
Readln(f,n,m);
sursa:=0;
dest:=2*n+1;
aloca;
for i:=1 to n do
begin
for j:=1 to m do
begin
Read(f,k);
cap[k]^[i+n]:=1;
cost[k]^[i+n]:=abs(i-k);
cost[i+n]^[k]:=-cost[k]^[i+n]
end;
Readln(f)
end;
Close(f)
end;
proceduredrumul_minim;
begin
for i:=sursa to dest do
begin
d[i]:=maxint;
tata[i]:=sursa
end;
d[sursa]:=0;
repeat
actua:=false;
for i:=sursa to dest do
if d[i]<>maxint
then
for j:=sursa to dest do
if cap[i]^[j]=1
then
if d[i]+cost[i]^[j]<d[j]
then
begin
d[j]:=d[i]+cost[i]^[j];
tata[j]:=i;
actua:=true
end
until not actua
end;
procedureumple_sigur;
begin
i:=dest;
while i<>0 do
begin
j:=tata[i];
cap[j]^[i]:=0;
cap[i]^[j]:=1;
i:=j
end
end;
procedureumple;
begin
drumul_minim;
umple_sigur
end;
function gata:Boolean;
begin
v:=0;
for i:=n+1 to 2*n do
if cap[i]^[dest]=0 then v:=v+1;
gata:=v=n
end;
procedurescrie;
begin
t:=0;
for i:=1 to n do
begin
k:=0;
for j:=n+1 to 2*n do
if (cap[i]^[j]=0) and cost[i]^[j]<>maxint)
then k:=j;
t:=t+cost[i]^[k]
end;
Assign(f,'BOMBON.OUT'); Rewrite(f);
Writeln(f,t);
for i:=1 to n do
begin
k:=0;
for j:=n+1 to 2*n do
if (cap[i]^[j]=0) and cost[i]^[j]<>maxint)
then k:=j;
Write(f,k-n,' ')
end;
Close(f)
end;
Begin{ programul principal }
load;
repeat umple until gata;
scrie
End.