It sounds like the OP is actually asking for the inverse Collatz iterator, which can be written as such:
In[]:=
inverseCollatz[x_Integer]:=Cases[{2x,(2x-1)/3},_Integer]
This iteration will go on forever, but it’s not guaranteed to reach every integer:
In[]:=
invg=NestGraph[inverseCollatz,{1},10,GraphLayout->"LayeredDigraphEmbedding"]
Out[]=
Since we can delete the one loop at the origin and stratify vertices, assuming a lex order per level, we can then look up the result in OEIS:
In[]:=
Catenate[ResourceFunction["VertexStratify"][EdgeDelete[%,2->1]]]
Out[]=
{1,2,4,8,5,16,3,10,32,6,20,21,64,12,13,40,42,128,24,26,80,84,85,256,17,48,52,53,160,168,170,512,11,34,35,96,104,106,113,320,336,340,341,1024}
As it says in OEIS, “The Collatz conjecture is true if and only if all odd numbers appear in this sequence”.
The OP also asked for user interactivity, which we’ve recently discussed in a post about building imaginary LEGOs in the computational universe (and it’s not just Kotaro and me, Hwano Lee from South Korea is doing even more complicated builds worth over 10,000 votes!).
In[]:=
DynamicModule[{graph=Graph[{1},{}],terms},Dynamic[terms=Select[VertexList[graph],VertexOutDegree[graph,#]==0&];ReverseGraph[graph,VertexSize->1/4,VertexLabels->Placed[Automatic,Center],GraphLayout->"LayeredDigraphEmbedding",VertexShapeFunction->Function[{loc,name,scale},If[MemberQ[terms,name],EventHandler[Disk[loc,scale],{"MouseClicked":>Set[graph,Graph[Join[EdgeList[graph],DirectedEdge[name,#]&/@inverseCollatz[name]]]]}],Disk[loc,scale]]]]]]
Out[]=
I clicked around and got the graph above. it seems to work fine.
FixedPointGraph
FixedPointGraph
Lately It seems that most use cases for NestWhileGraph are actually better formulated as cases for FixedPointGraph, which we are in the process of developing for WFR. Here’s an example that avoids needing the complicated conditional from Ian’s response:
In[]:=
collatz[n_?EvenQ]:={n/2}collatz[n_?OddQ]:={(3n+1)/2}
In[]:=
Graph[FixedPointGraph[collatz,Range[25]],VertexLabels->Automatic,GraphLayout->"LayeredDigraphEmbedding"]
Out[]=
code (FixedPointGraph)
code (FixedPointGraph)
In[]:=
FixedPointGraph[iter_,init_,max_:Infinity]:=Module[{ht,temp,res},ht=CreateDataStructure["HashTable"];ht["Insert",#->#]&/@init;res=Reap[FixedPoint[CompoundExpression[temp=MultiIterate[iter,Identity][#],temp=Select[temp,MissingQ[ht["Lookup",#]]&],ht["Insert",#->#]&/@temp,temp]&,init,max]];Graph[Keys[ht["Elements"]],Union[Flatten[res[[2,1]]]]]]
In[]:=
CanonicalizeBy[signature_,ord_:Sort][states_]:=Module[{dict},dict=Association[Catenate[Map[Function[alts,#->First[alts]&/@alts],Values[Map[ord,GroupBy[Catenate[states],signature]]]]]];Union[Lookup[dict,#]]&/@states]