252
>
{determina cliclu eulerian dintr-un graf, daca exista} program ciclu_eulerian; uses crt; type mat=array [1..20,1..20] of integer; sir=array [1..20] of integer; var a:mat;s:sir; n,m,i,j,k,prim:integer; gasit:boolean; procedure cit; begin write('n=');readln(n); m:=0;prim:=0; for i:=1 to n-1 do for j:=i+1 to n do begin write('a[',i,',',j,']=');readln(a[i,j]); if a[i,j]=1 then begin m:=m+1; prim:=i; end; a[j,i]:=a[i,j]; end; end; function valid(k:integer):boolean; var i:integer; begin valid:=true; if a[s[k],s[k-1]]=0 then valid:=false; if (k=m)and(a[s[k],s[1]]=0)then valid:=false; end; procedure back(k:integer); var i,j:integer; begin i:=1; while (i<=n)and(not gasit) do begin s[k]:=i; if valid(k) then begin a[s[k],s[k-1]]:=0; a[s[k-1],s[k]]:=0; if k=m then begin gasit:=true; writeln('Ciclul eulerian este:'); for j:=1 to m do write(s[j],' '); writeln(s[1]); end else back(k+1); a[s[k],s[k-1]]:=1; a[s[k-1],s[k]]:=1; end; i:=i+1; end; end; procedure tip; begin clrscr; writeln('Matricea de adiacenta:'); for i:=1 to n do begin for j:=1 to n do write(a[i,j],' '); writeln; end; writeln; end; begin{PP} clrscr; cit; tip; if prim<>0 then begin s[1]:=prim; gasit:=false; back(2); if not gasit then write('Graful nu este eulerian.'); end else write('Graful nu este eulerian.'); readkey; end. {PascalZone.uv.ro}