Cod sursa(job #581120)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 13 aprilie 2011 19:39:41
Problema Ubuntzei Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.24 kb
{Cioara Andrei}
var v:array [1..2000, 1..2000] of longint;
    buf:array[1..1 shl 17] of char;
    m, n, k, i, j, x, y, d, l:longint;
    min, pmin:longint;
    total:int64;
    eend:array [1..2000] of boolean;
    viz:array[1..2000] of boolean;
    f, g:text;

begin
assign (f, 'ubuntzei.in'); settextbuf(f, buf); reset (f);
assign (g, 'ubuntzei.out'); rewrite (g);

readln (f, n, m);
for i := 1 to n do for j := 1 to n do if i <> j then v[i, j]:=100001;
read (f, k);
for i := 1 to k do begin read (f, x); viz[x]:=true; end;

for i := 1 to m do
  begin
  read (f, x, y, d);
  v[x, y]:=d;
  v[y, x]:=d;
  end;

for l := 1 to n do
  for i := 1 to n do
    for j := 1 to n do
      if (v[i, l]+v[l, j]<v[i, j]) and (i<>l) and (j<>l) then v[i, j]:=v[i, l]+v[l, j];

x:=1; eend[1]:=true;
for i := 1 to k do
  begin
  min:=maxlongint;
  for j := 1 to n do
    begin
    if (v[x, j]<min) and viz[j]=true then
      begin
      min:=v[x, j]; pmin:=j;
      end;
    end;
  x:=pmin; total:=total+min;
  viz[x]:=false;
  eend[x]:=true;
  end;

x:=n;
min:=maxlongint;
for j := 1 to n do
  begin
  if (v[x, j]<min) and (eend[j]=true) then min:=v[x, j];
  end;
total:=total+min;


write (g, total);
close (f); close (g);
end.