[ From Nik ]
[ From Nik ]
In[]:=
movesmulti[state_:{_List..},pegs_:3]:=Flatten[MapIndexed[Function[{p,i},With[{smallerDisks=MapAt[Drop[#,i[[2]]]&,Drop[state,i[[1]]-1],{1}]},If[MemberQ[Catenate@smallerDisks,p],{},(available|->ReplacePart[state,i->available])/@Complement[Range[pegs],Catenate@smallerDisks,{p}]]]],state,{2}],2]
In[]:=
hanoiPlot//ClearAllhanoiPlot[state_,pegs_:3,opts:OptionsPattern[]]:=Graphics[{First@Fold[With[{p=#1[[3]]},Append[p+1]@Fold[With[{g=#1[[1]],stack=#1[[2]],disk=#2},{Append[g,{EdgeForm[Black],FaceForm[Gray],Rectangle[{disk+p/10,stack[disk]/4},{disk+1-p/10,(stack[disk]+1)/4}]}],MapAt[#+1&,stack,disk]}]&,#1[[;;2]],#2]]&,{{},AssociationThread[Range@pegs,0],1},state],Style[InfiniteLine[{{#,0},{#,1}}],GrayLevel[.7]]&/@Range[2,pegs]},opts,PlotRange{{1,pegs+1},{0,.1+Length[Catenate[state]]/4}},ImageSizeTiny]
In[]:=
ResourceFunction["NestGraphTagged"][x|->movesmulti[x,4],{{{1},{1},{1}}},10,"RuleStyling"->None,"StateLabeling"->True,"FormattingFunction"->(hanoiPlot[#,4,ImageSize->50]&)]
Out[]=
In[]:=
ResourceFunction["NestGraphTagged"][x|->movesmulti[x,3],{{{1,1},{1,1},{1,1}}},100,"RuleStyling"->None,"StateLabeling"->False]
Out[]=
In[]:=
ResourceFunction["NestGraphTagged"][x|->movesmulti[x,3],{{{1},{1},{1}}},8,"RuleStyling"->None,"StateLabeling"->True,"FormattingFunction"->(hanoiPlot[#,3]&)]
Out[]=