Help:=proc():print(`Cyc(L,i),AJ(L)`):end: #Cyc(L,i): inputs a list L and #1<=i<=n and outputs the unique cycle #in its orbit Cyc:=proc(L,i) local M,la,j: M:=[i]: while not member(M[nops(M)],{op(1..nops(M)-1,M)}) do: M:=[op(M),L[M[nops(M)]] ]: od: M: la:=M[nops(M)]: for j from 1 to nops(M) while M[j]<>la do od: M:=[op(j..nops(M),M)]: {seq( [M[j],M[j+1]],j=1..nops(M)-1)}: end: AJ:=proc(L) local n,i,CP,G,G1,T,edge,CP1,G2,G2p,root1,root2: n:=nops(L): G:={ seq( [i,L[i]], i=1..n) }: CP:={seq(op(Cyc(L,i)),i=1..n)}: G1:=G minus CP: for i from 1 to nops(CP) do edge:=CP[i]: T[edge[1]]:=edge[2]: od: CP:={seq(CP[i][1],i=1..nops(CP))}: CP1:=sort(convert(CP,list)): G2p:=[seq(T[CP1[i]],i=1..nops(CP1))]: root1:=G2p[1]: root2:=G2p[nops(G2p)]: G2p:={seq([G2p[i],G2p[i+1]],i=1..nops(G2p)-1)}: G1:=G1 union G2p: G1:={seq(convert(G1[i],set),i=1..nops(G1))}: G1,root1,root2: end: