Cod sursa(job #578935)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 11 aprilie 2011 18:53:42
Problema Ciclu Eulerian Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.97 kb
type muchie = ^nod;
     nod = record n:longint; a:muchie; s:boolean; end;

var v:array [0..100000] of muchie;
    par:array [1..100000] of longint;
    sol, temp:array[-1..500000] of longint;
    m, n, i, x, y, vf, t, c:longint;
    p, r, q:muchie;
    f, g:text;
    k:boolean;
    buf1, buf2:array[1.. 1 shl 17] of char;

begin
assign (f, 'ciclueuler.in'); settextbuf (f, buf1); reset (f);
assign (g, 'ciclueuler.out'); settextbuf (g, buf2); rewrite (g);

readln (f, n, m);
for i := 1 to m do
  begin
  read (f, x, y);
  if v[x]= nil then
    begin
    new(v[x]); v[x]^.a:=nil; v[x]^.n:=y; v[x]^.s:=false;
    end
               else
    begin
    p:=v[x];
    while p^.a <> nil do p:=p^.a;
    new(r); p^.a:=r; r^.a:=nil; r^.n:=y; r^.s:=false;
    end;

  if v[y]= nil then
    begin
    new(v[y]); v[y]^.a:=nil; v[y]^.n:=x; v[y]^.s:=false;
    end
               else
    begin
    p:=v[y];
    while p^.a <> nil do p:=p^.a;
    new(r); p^.a:=r; r^.a:=nil; r^.n:=x; r^.s :=false;
    end;
  inc(par[x]); inc(par[y]);
  end;


c:=1;
for i := 1 to n do
  begin
  if par[i] mod 2 = 1 then c:=-1;
  end;

i:=0;
if c=-1 then writeln (g, c)
            else
  begin
  p:=v[c];
  vf:=1; t:=0;
  while vf>0 do
    begin
    if p <> nil then
      begin
      if p^.s = false then
        begin
        temp[vf]:=p^.n;
        inc (vf);
        p^.s := true;

        q:=v[p^.n];
        k:= true;
        while k and (q<> nil) do
          begin
          if (q^.n=c) and (q^.s=false) then begin k := false; q^.s:=true; end;
          q:=q^.a;
          end;
        c:=p^.n;
        p:=v[p^.n];
        end
                        else
        begin
        p:=p^.a;
        end;
      end
                else
      begin
      inc (t);
      dec(vf);
      sol[t]:= temp[vf];
      p:=v[temp[vf-1]];
      c:=temp[vf-1];
      end;
    end;
  end;

for i := 1 to t-1 do write (g, sol[i], ' ');

close (f); close (g);
end.