Cod sursa(job #1639227)

Utilizator RADU98Cotisel Radu RADU98 Data 8 martie 2016 11:26:47
Problema Ubuntzei Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.35 kb
PROGRAM UBUNTZEI;
var P,n,m,k,I:integer; t,v,d:array[0..20000] of integer;
cost:array[0..200,0..200] of longint;
s:array[0..200] of boolean;
F:TEXT;

PROCEDURE CITIRE;
var i,x,y,z,j:integer; f:text;
begin
assign(f,'ubuntzei.in');reset(f);
readln(f,n,m);
read(f,k);
for i:=1 to k do
read(f,v[i+1]);

v[1]:=1;
v[k+2]:=n;
k:=k+2;

for i:=1 to n do
for j:=1 to n do
if i<>j then
cost[i,j]:=maxint;

for i:=1 to m do
begin
readln(f,x,y,z);
cost[x,y]:=z;
cost[y,x]:=z;
end;
close(f);
end;

procedure tipar;
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do
write(cost[i,j]:5) ;
writeln;
end;
   writeln;
   end;


PROCEDURE INITIALIZARE(X:INTEGER);
VAR i:integer;
BEGIN
FOR I:=1 TO N DO D[I]:=COST[X,I];
FOR I:=1 TO N DO
IF (D[I]<MAXINT) AND (i<>x) then
t[i]:=x
else
t[i]:=0;

t[x]:=-1;
for i:=1 to n do
s[i]:=false;
s[x]:=true;
end;


PROCEDURE DIJKSTRA;
var r,dmin,i,k:integer;
begin
for r:=1 to n-1 do
begin
dmin:=maxint;
for i:=1 to n do
if (d[i]<dmin) and(not s[i]) then
begin dmin:=d[i]; k:=i; end;


for i:=1 to n do
if (d[i]>d[k]+cost[k,i]) then
begin
d[i]:=d[k]+cost[k,i];
t[i]:=k;
end;
s[k]:=true;
end;
END;

BEGIN
CITIRE; tipar;
FOR I:=1 TO K-1 DO
BEGIN
INITIALIZARE(V[I]);
DIJKSTRA;
P:=P+D[V[I+1]];
END;

ASSIGN(F,'ubuntzei.out');REWRITE(F);
WRITE(F,P);
CLOSE(F);
END.