Cod sursa(job #594760)

Utilizator vendettaSalajan Razvan vendetta Data 9 iunie 2011 15:16:48
Problema Ciclu Eulerian Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.09 kb
type pnod=^nod;
     nod = record
        info : longint;
        next : pnod;
end;
const f = 'ciclueuler.in'; g = 'ciclueuler.out';
const max_n = 100001;
      max_m = 500001;
var
    LA : array[1..max_n] of pnod;
    spa, sol : array[1..max_m] of longint;
    gr : array[1..max_n] of longint;
    n, m : longint;
    vf, nsol, st, i, x, y : longint;

procedure add( var dest : pnod; val : longint );
    var
        q : pnod;
    begin
        new( q );
        q^.next := dest;
        q^.info := val;
        dest := q;
    end;

function eulerian : boolean;
    var
        i : longint;
    begin
    eulerian := true;
    for i := 1 to n do
        if (gr[i] mod 2 = 1 ) or (gr[i] = 0) then begin
            eulerian := false;
            break;
        end;
    end;
procedure elimin( x, y : longint );
    var
        q, p : pnod;
    begin

        q := LA[x];
        LA[x] := LA[x]^.next;
        dispose( q );

        if LA[y]^.info = x then begin
            q := LA[y];
            LA[y] := LA[y]^.next;
            dispose( q );
        end
        else begin
            q := LA[y];
            while ( q^.next^.info <> x ) do q := q^.next;
            p := q^.next;
            q^.next := p^.next;
            dispose( p );
        end;
    end;

begin
    assign( input,f ); reset( input );
    assign( output,g ); rewrite( output );
    readln( n, m );
    for i := 1 to m do begin
        readln( x,y );
        add( LA[x], y );
        add( LA[y], x );
        inc( gr[x] );
        inc( gr[y] );
    end;
    if ( not eulerian ) then writeln( '-1' ) else
        st := 1;
        spa[st] := 1;
        while st <> 0 do begin
            vf := spa[st];
            if (LA[vf] <> nil )  then begin
                inc( st );
                spa[st] := LA[vf]^.info;
                elimin( vf, LA[vf]^.info);
            end
            else begin
                inc( nsol );
                sol[nsol] := spa[st];
                dec( st );
            end;
    end;

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


end.