Cod sursa(job #288850)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 26 martie 2009 10:05:45
Problema Ciclu Eulerian Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.17 kb
// Arhiva Educationala  - Ciclu Eulerian

type
    adresa = ^nod;
    nod = record inf:longint; adr : adresa; end;

var
    n, m, i, x, y, a, b: longint;
    v : array[1..100000] of adresa;
    grad : array[1..100000] of longint;
    f : text;
    p, q, pp, qq, r: adresa;

procedure sterge (x, y: longint);
var
    q,t : adresa;
begin
dec (grad[x]); dec (grad[y]);

q := v[x]; v[x] := v[x]^.adr; dispose (q);

if (v[y]^.inf=x) then
    begin
    q := v[y]; v[y] := v[y]^.adr; dispose (q);
    exit;
    end;

q := v[y];
while (q^.adr<>nil) and (q^.adr^.inf <> x) do
    q :=  q^.adr;
t := q^.adr; q^.adr := q^.adr^.adr; dispose (t);
end;



begin
assign  (f, 'ciclueuler.in');
reset   (f);
readln  (f, n, m);
for i:=1 to m do
    begin
    readln (f, x,y);
    inc(grad[x]); inc(grad[y]);
    new (q); q^.inf := x; q^.adr := v[y]; v[y] := q;
    new (q); q^.inf := y; q^.adr := v[x]; v[x] := q;
    end;
close   (f);

assign  (f, 'ciclueuler.out');
rewrite (f);

for i:=1 to n do
    if ((grad[i] and 1) = 1)  then
        begin
        writeln (f, -1);
        halt;
        end;

new (p);
p^.inf := 1;
p^.adr := nil;
q := p;
while  (q^.adr <> p) do
    begin
    a := q^.inf;
    b := v[q^.inf]^.inf;

    if (b = p^.inf) then
       q^.adr := p
    else
       begin
       new (q^.adr); q^.adr^.inf := b; q^.adr^.adr := nil;
       q := q^.adr;
       end;
    sterge (a,b);
    end;

q := p;
repeat

if grad[q^.inf] <> 0 then
    begin
    new(pp);
    pp^.inf := q^.inf; pp^.adr := nil;
    qq := pp;
    x := q^.inf;

    while (qq^.adr <> pp) do
        begin
        a := qq^.inf;
        b := v[qq^.inf]^.inf;

        if (b = pp^.inf) then
            qq^.adr := pp
        else
            begin
            new (qq^.adr); qq^.adr^.inf:=b; qq^.adr^.adr := nil; qq := qq^.adr;
            end;
        sterge (a, b);
        end;

    r := pp;
    pp := pp^.adr;
    dispose(r);

    new(r); r^.inf := x;
    r^.adr := q^.adr;
    qq^.adr := r;
    q^.adr := pp;

    end
else
    q := q^.adr;
until q = p;


q:=p;
repeat
 write(f, q^.inf, ' ');
q:=q^.adr;
until q = p;


close   (f);
end.