Cod sursa(job #584550)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 25 aprilie 2011 22:37:21
Problema Ubuntzei Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.75 kb
var     a:array[1..3,1..10000] of int64;
        b:array[1..16,1..2000] of int64;
        buf:array[1..1000000] of char;
        o:array[0..17] of longint;
        n,m,k,i,j:longint;
        L:int64;
        bo:boolean;
        f,g:text;

procedure verificare;
var     i:longint; x:int64;
begin
  x:=0;
  for i:=1 to k+1 do
    x:=x+b[o[i],o[i+1]];
  if x<L then L:=x;
end;

procedure sw(var a,b:longint);
var     t:longint;
begin
  t:=a; a:=b; b:=t;
end;

procedure perm(p:longint);
var     i:longint;
begin
  if p>k then verificare else
    begin
      for i:=p to k do
        begin
          sw(o[i+1],o[p+1]);
          perm(p+1);
          sw(o[i],o[p+1]);
        end;
    end;
end;

begin
  assign(f,'ubuntzei.in');
  assign(g,'ubuntzei.out');
  reset(f);
  rewrite(g);
  settextbuf(f,buf);
  readln(f,n,m);
  read(f,k);
  o[1]:=1;
  o[k+2]:=n;
  for i:=2 to k+1 do
    read(f,o[i]);
  for i:=1 to m do
    readln(f,a[1,i],a[2,i],a[3,i]);

  for i:=1 to k+1 do
  for j:=1 to n do
    b[i,j]:=-1;

  for i:=1 to k+1 do
    begin
      b[i,o[i]]:=0;
      bo:=true;
      while bo do
        begin
          bo:=false;
          for j:=1 to m do
            begin
              if ((b[i,a[1,j]]>-1)and((b[i,a[2,j]]=-1)or(b[i,a[2,j]]>b[i,a[1,j]]+a[3,j]))) then
                begin
                  b[i,a[2,j]]:=b[i,a[1,j]]+a[3,j];
                  bo:=true;
                end;
              if ((b[i,a[2,j]]>-1)and((b[i,a[1,j]]=-1)or(b[i,a[1,j]]>b[i,a[2,j]]+a[3,j]))) then
                begin
                  b[i,a[1,j]]:=b[i,a[2,j]]+a[3,j];
                  bo:=true;
                end;
            end;
        end;
    end;

  L:=200000000000000;
  perm(1);
  writeln(g,L);
  close(g);
end.