Cod sursa(job #964346)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 20 iunie 2013 17:36:53
Problema Ciclu hamiltonian de cost minim Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 1.33 kb
program hamilton;
  type lista=^celula;
       celula=record
                info:longint;
                next:lista;
              end;
  var n,m,x,y,z,i:longint;
      a:array [0..17] of lista;
      c:array [0..17,0..17] of longint;
      r:lista;
      h,ans:longint;
      min:longint;
      visited:array [0..17] of byte;

procedure dfs(x:longint);
  var q:lista;
  begin
    if h=n-1 then
      begin
        if (c[x,0]<>0) and (ans+c[x,0]<min)then min:=ans+c[x,0];
      end else begin
    q:=a[x];
    while q <> nil do
      begin
        if (c[x,q^.info]<>0)and(visited[q^.info]=0)and(ans<min) then
          begin
            visited[q^.info]:=1;
            ans:=ans+c[x,q^.info];
            inc(h);
            dfs(q^.info);
            dec(h);
            ans:=ans-c[x,q^.info];
            visited[q^.info]:=0;
          end;
        q:=q^.next;
      end;  end;
  end;


begin
  assign(input,'hamilton.in');
  reset(input);
  assign(output,'hamilton.out');
  rewrite(output);

  readln(n,m);
  for i:=1 to m do
    begin
      readln(x,y,z);
      c[x,y]:=z;
      new(r);
      r^.info:=y;
      r^.next:=a[x];
      a[x]:=r;
    end;

  min:=1000000000;
  visited[0]:=1;
  dfs(0);

  if min=1000000000 then writeln('Nu exista solutie')
     else writeln(min);
  close(output);
end.