Program PgmWayDepth; {Paarlase dzilumaa neorienteetaa grafaa} uses CRT,DOS; Const nVertex=100; {Maksimaalais virsotnu skaits} nAdjacent=1000; {Maksimaalais elementu skats ievadfailaa} Type TypeVertex=array[1..nVertex] of Integer; TypeAdjacent=array[1..nAdjacent] of Integer; Var f :Text; n :Integer; nt :Integer; Adj :TypeAdjacent; Fst :TypeVertex; Nbr :TypeVertex; Vtx :TypeVertex; Mark :TypeVertex; T :TypeVertex; B :TypeVertex; Procedure Init( Var yes :Boolean ); Var i,j,m :Integer; begin for i:=1 to n do for j:=1 to Nbr[i] do begin yes:=FALSE; for m:=1 to n do if Adj[Fst[i]+j]=Vtx[m] then begin yes:=TRUE; Adj[Fst[i]+j]:=m; break; end; if not yes then exit; end; end; Procedure Depth( x,u:Integer; var count :Integer); Var i,v :Integer; begin count:=count+1; Mark[x]:=count; for i:=1 to Nbr[x] do begin v:=Adj[Fst[x]+i]; if Mark[v]=0 then begin nT:=nT+2; T[nT-1]:=x; T[nT]:=v; B[nT div 2]:=1; Depth(v,x,count); end else if (Mark[v]u) then begin nT:=nT+2; T[nt-1]:=x; T[nt]:=v; B[nT div 2]:=0; end; end; end; Procedure WayDepth; Var v,count :Integer; begin nT:=0; count:=0; for v:=1 to n do Mark[v]:=0; for v:=1 to n do if Mark[v]=0 then Depth(v,0,count); end; Var i,j :Integer; yes :Boolean; begin Assign(f,'Depth.in'); Reset(f); Read(f,n); Fst[1]:=0; for i:=1 to n do begin Read(f,Vtx[i]); Read(f,Nbr[i]); for j:=1 to Nbr[i] do Read(f,Adj[Fst[i]+j]); Fst[i+1]:=Fst[i]+Nbr[i]; end; Close(f); Assign(f,'Depth.out'); rewrite(f); Init(yes); if not yes then begin WriteLn(f,'Slikts grafa kaiminsaraksts!'); Close(f); exit; end; WayDepth; for i:=1 to nT div 2 do Write(f,Vtx[T[2*i-1]]:3); Writeln(f); for i:=1 to nT div 2 do Write(f,Vtx[T[2*i]]:3); Writeln(f); for i:=1 to nT div 2 do Write(f,B[i]:3); Writeln(f); Close(f); end.