PCYCLE - Thám hiểm mê cung

Tác giả: RR

Ngôn ngữ: Pascal

{$R+,Q+}
PROGRAM PCYCLE;
CONST
  FINP='';
  FOUT='';
  maxn=202;
  maxm=20002;
VAR
  c:array[0..maxn,0..maxn] of longint;
  x:array[1..maxn,1..maxn] of longint;
  total:array[1..maxm+1] of longint;
  deg,xet:array[1..maxn] of longint;
  e,s:array[1..maxm+1] of longint;
  start,n,m:longint;
procedure readInput;
var
  f:text;
  i,u,v:longint;
begin
  assign(f,FINP); reset(f);
  read(f,n,m);
  for i:=1 to m do
    begin
      read(f,u,v,c[u,v]);
      c[v,u]:=c[u,v];
      x[u,v]:=1; x[v,u]:=1;
      inc(deg[u]); inc(deg[v]);
    end;
  close(f);
end;
function ktlt:boolean;
var
  i:longint;
  procedure DFS(u:longint);
  var
    v:longint;
  begin
    xet[u]:=1;
    for v:=1 to n do
      if (x[u,v]=1) and (xet[v]=0) then DFS(v);
  end;
begin
  DFS(1);
  ktlt:=false;
  for i:=1 to n do
    if xet[i]=0 then exit;
  ktlt:=true;
end;
function ktctE:boolean;
var
  i:longint;
begin
  ktctE:=false;
  for i:=1 to n do
    if deg[i] mod 2<>0 then exit;
  ktctE:=true;
end;
procedure writeOutput(k:longint);
var
  f:text;
  i,j:longint;
begin
  assign(f,FOUT); rewrite(f);
  if k=0 then begin writeln(f,-1); close(f); halt; end;
  j:=start;
  for i:=1 to m+1 do
    begin
      write(f,e[j],' ');
      inc(j);
      if j=m+1 then j:=1;
    end;
  close(f);
end;
procedure EulerCycle;
var
  top,u,i,sl:longint;
begin
  top:=1; s[1]:=n;
  sl:=0;
  while top>0 do
    begin
      u:=s[top];
      i:=1;
      while (i<=n) and (x[u,i]=0) do inc(i);
      if i<=n then
        begin
          inc(top);
          s[top]:=i;
          x[u,i]:=0; x[i,u]:=0;
        end
      else
        begin
          inc(sl);
          e[sl]:=u;
          dec(top);
        end;
    end;
end;
procedure process;
var
  i:longint;
begin
  for i:=2 to m+1 do
    total[i]:=total[i-1]+c[e[i-1],e[i]];
  start:=1;
  for i:=2 to m+1 do
    if total[i]<total[start] then start:=i;
  if start=m+1 then start:=1;
end;
function ktok:boolean;
var
  i,j:longint;
  t:longint;
begin
  ktok:=false;
  t:=0; j:=start;
  for i:=1 to m+1 do
    begin
      t:=t+c[e[j],e[j+1]];
      if t<0 then exit;
      inc(j);
      if j=m+1 then j:=1;
    end;
  ktok:=true;
end;
BEGIN
  readInput;
  if not ktlt then writeOutput(0);
  if not ktctE then writeOutput(0);
  EulerCycle;
  process;
  if not ktok then writeOutput(0);
  writeOutput(1);
END.

Download