Cod sursa(job #1418826)

Utilizator ButnaruButnaru George Butnaru Data 14 aprilie 2015 09:18:55
Problema Ciclu Eulerian Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.35 kb
program ciclu_eulerian;
  type lista=^celula;
       celula=record
                info:longint;
                next:lista;
              end;
  var n,m,i,x,y:longint;
      a:array [1..100000] of lista;
      r:lista;
      grad:array [1..100000] of longint;
      ok:boolean;
      bufin,bufout:array [1..100000] of byte;

procedure euler(x,y:longint);
  var w:longint;
      r:lista;
  begin
    while a[x]<>nil do
      begin
        w:=a[x]^.info;
        a[x]:=a[x]^.next;
        r:=a[w];
        if  r^.info=x then a[w]:=a[w]^.next else
          begin
            while r^.next^.info<>x do r:=r^.next;
            r^.next:=r^.next^.next;
          end;
        euler(w,y+1);
      end;
    if y>0 then write(x,' ');
  end;

begin
  assign(input,'ciclueuler.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'ciclueuler.out');
  rewrite(output);
  settextbuf(output,bufout);

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

  ok:=true;
  for i:=1 to n do
    if odd(grad[i]) then ok:=false;  {verificarea existentei ciclului}

  if ok then euler(1,0) else writeln(-1);
  close(output);
end.