Listing: DRUMURI.PAS
{$b-,e+,n+}
const maxlin=35; maxcol=85;
maxnod=maxlin*maxcol;
type vecint=array[1..maxnod] of Integer;
vec4int=array[1..maxnod,1..4]of Integer;
veclong=array[1..maxnod] of Longint;
vecbool=array[1..maxnod] of Boolean;
vecdouble=array[1..maxnod] of Double;
var a:array[1..maxlin] of string[maxcol];
nvecini:vecint;
vecini,cost:vec4int;
nlin,ncol,n,start,stop:Integer;
function punct2vf(lin,col:Integer):Integer;
begin
punct2vf:=ncol*(lin-1)+col
end;
procedure vf2punct(i:Integer;
var lin,col:Integer);
begin
lin:=((i-1) div ncol)+1;
col:=((i-1) mod ncol)+1
end;
procedure citire;
var i,j,k,l,cc:Integer;
gasit:Boolean;
begin
nlin:=0;
repeat
Inc(nlin);
Readln(a[nlin])
until a[nlin,1]='_';
Dec(nlin);
ncol:=Length(a[1]);
n:=nlin*ncol;
gasit:=false;
for i:=1 to nlin do
for j:=1 to ncol do
if a[i,j]=#1
then if not gasit
then begin
start:=punct2vf(i,j);
gasit:=true
end
else stop:=punct2vf(i,j);
Fillchar(nvecini,Sizeof(nvecini),0);
Fillchar(vecini,Sizeof(vecini),0);
Fillchar(cost,Sizeof(cost),0);
for i:=1 to nlin do
for j:=1 to ncol do
if a[i,j]<>#219
then
begin
k:=punct2vf(i,j);
if (i>1) and (a[i-1,j]<>#219)
then
begin
Inc(nvecini[k]);
vecini[k,nvecini[k]]:=
punct2vf(i-1,j)
end;
if (i<nlin) and (a[i+1,j]<>#219)
then
begin
Inc(nvecini[k]);
vecini[k,nvecini[k]]:=
punct2vf(i+1,j)
end;
if (j>1) and (a[i,j-1]<>#219)
then
begin
Inc(nvecini[k]);
vecini[k,nvecini[k]]:=
punct2vf(i,j-1)
end;
if (j<ncol) and (a[i,j+1]<>#219)
then
begin
Inc(nvecini[k]);
vecini[k,nvecini[k]]:=
punct2vf(i,j+1)
end;
if a[i,j]=#1
then cc:=1
else cc:=1+Ord(a[i,j])-175;
if k=start
then cc:=2;
for l:=1 to nvecini[k]
do
cost[k,l]:=cc
end
end;
var ales:^vecbool;
ntati:^vecint;
tati:^vec4int;
minim:^veclong;
procedure alege(i:Integer);
var j,k:Integer;
begin
ales^[i]:=true;
for j:=1 to nvecini[i] do
begin
k:=vecini[i,j];
if minim^[k]<minim^[i]+cost[i,j]
then Continue;
if minim^[k]>minim^[i]+cost[i,j]
then
begin
minim^[k]:=minim^[i]+cost[i,j];
ntati^[k]:=1; tati^[k,1]:=i;
Continue
end;
Inc(ntati^[k]);
tati^[k,ntati^[k]]:=i
end;
end;
var ndrumuri:^vecdouble;
function drumuri(i:Integer):Double;
var j,k:Integer;
begin
if ndrumuri^[i]<0
then
if i=start
then ndrumuri^[i]:=1
else
begin
vf2punct(i,j,k);
a[j,k]:=' ';
ndrumuri^[i]:=0;
for j:=1 to ntati^[i] do
ndrumuri^[i]:=ndrumuri^[i]+
drumuri(tati^[i,j])
end;
drumuri:=ndrumuri^[i]
end;
var i,j,k:Integer;
Begin
Assign(input,'D.DAT'); Reset(input);
New(minim); New(ntati); New(tati);
New(ales); New(ndrumuri);
while not Seekeof do
begin
citire;
Fllchar(ales^,Sizeof(ales^),0);
Fillchar(ntati^,Sizeof(ntati^),0);
for i:=1 to n
do
minim^[i]:=MaxLongint div 2;
minim^[start]:=0;
alege(start);
for i:=1 to n-1 do
begin
j:=0;
for k:=1 to n do
if not ales^[k]
then
if j=0
then j:=k
else if minim^[j]>minim^[k]
then j:=k;
if minim^[j]=MaxLongint div 2
then Break;
alege(j)
end;
if minim^[stop]=MaxLongint div 2
then Writeln('0 drumuri, cost 0')
else
begin
for i:=1 to n do ndrumuri^[i]:=-1;
Writeln(drumuri(stop):0:0,
' drumuri, cost ',minim^[stop]);
vf2punct(stop,j,k); a[j,k]:=#1
end;
for i:=1 to nlin+1 do Writeln(a[i])
end;
Close(input)
End.