WOLFRAM NOTEBOOK

In[]:=
Module[{g0,gw},g0=VertexReplace[NearestNeighborGraph[Keys[$LifetimeData[2,2,"Symmetric"]],{All,3/2},DistanceFunction->BinaryMutationDistance,VertexCoordinates->Automatic,GraphLayout->"SpringElectricalEmbedding"],x_:>{x}];gw=EvolutionaryMultiwayGraph[changeFitness[{2,2},$LifetimeData[2,2,"Symmetric"],Length@*First],GraphLayout->"LayeredDigraphEmbedding","Reduced"->True,AspectRatio->.6,EdgeStyle->Gray];addVertexFigures[Subgraph[g0,Map[List,#]],$LifetimeData[2,2,"Symmetric"],{2,2},EdgeStyle->Gray,GraphLayout->"SpringElectricalEmbedding",VertexSize->1/4,AspectRatio->2/3,ImageSize->Tiny]&/@Select[VertexList[gw],Length[#]>1&]]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
In[]:=
VertexList/@%103
Out[]=
{{{{1343260068,3646010879}},{{1048868,156317055}},{{1343260084,3646027263}},{{1049892,3507586495}},{{269484468,424769023}},{{3222308132,3507602879}},{{139469092,424769023}},{{139473252,3646010879}},{{3360731492,3646027263}}},{{{2551203236,4260494847}},{{2416985508,4189312511}}},{{{749738340,2113011199}},{{204478820,1039367679}},{{749754724,4260494847}},{{3970996580,4260494847}},{{613570916,4258528767}}},{{{2419066276,4122074623}},{{269616548,4120108543}},{{2419082660,4156415999}},{{2419066292,4122074623}},{{2453424036,4294836223}},{{269632932,4154449919}},{{303974308,4292870143}},{{2555536804,4294967295}},{{2555405732,4260625919}},{{269501860,4122205695}},{{336612772,4260625919}}},{{{70261092,494108159}},{{1823512932,4294967295}}},{{{2961310100,4120371199}},{{815792532,968316927}},{{947913108,1033330687}}},{{{2484211124,4294967295}},{{336727476,4294967295}},{{2518289844,4294967295}},{{370806196,4294967295}}},{{{335546772,1035427839}},{{503843220,1069506559}}},{{{303695284,4290502143}},{{2451178932,4290502143}},{{848954804,4160749567}}},{{{2519337364,4294967295}},{{2485258644,4294967295}},{{2489461140,4294967295}},{{2623678868,4294967295}}},{{{2619476372,4294967295}},{{3164735892,4260888575}}},{{{3662193044,4294967295}},{{1514709396,4294967295}}},{{{848823732,4294967295}},{{814745012,4294967295}}},{{{2418147732,4160749567}},{{2452226452,4160749567}}},{{{3028421012,4294967295}},{{880937364,4156547071}}}}
In[]:=
Length[%103]
Out[]=
15
In[]:=
ExpandLevelGraph[g0_,opts:OptionsPattern[Graph]]:=VertexReplace[NearestNeighborGraph[Catenate[MaskToLevelSet[{2,2},First[#]]&/@VertexList[g0]],{All,3/2},DistanceFunction->Function[DigitCount[BitXor[SymmetricEncode[#1[[1]]],SymmetricEncode[#2[[1]]]],2,1]],VertexCoordinates->Automatic],x_:>{x}]
In[]:=
Module[{g0,gw,gs,joing,res1,res,lts,emb},g0=VertexReplace[NearestNeighborGraph[Keys[$LifetimeData[2,2,"Symmetric"]],{All,3/2},DistanceFunction->BinaryMutationDistance,VertexCoordinates->Automatic,GraphLayout->"SpringElectricalEmbedding"],x_:>{x}];gw=EvolutionaryMultiwayGraph[changeFitness[{2,2},$LifetimeData[2,2,"Symmetric"],Length@*First],GraphLayout->"LayeredDigraphEmbedding","Reduced"->True,AspectRatio->.6,EdgeStyle->Gray];res1=addVertexFigures[Subgraph[g0,List/@#],$LifetimeData[2,2,"Symmetric"],{2,2},EdgeStyle->Gray,GraphLayout->"SpringElectricalEmbedding",VertexSize->1/4,AspectRatio->2/3,ImageSize->Tiny]&/@Select[VertexList[gw],Length[#]>1&];gs=Map[ExpandLevelGraph[res1[[#]],VertexSize->1/2]&,{10,14}];joing=Graph[Catenate[Outer[If[SameQ[1,DigitCount[BitXor[SymmetricEncode[#1[[1,1]]],SymmetricEncode[#2[[1,1]]]],2,1]],DirectedEdge[#1,#2],Nothing]&,VertexList[gs[[1]]],VertexList[gs[[2]]],1]]];res=HighlightGraph[GraphUnion@@Append[gs,joing],joing];lts=Association[#->$LifetimeData[2,2,"All"][{BitAnd@@#,Last[#]}]&/@Catenate[VertexList[res]]];emb=KeyValueMap[#1->If[MatchQ[#1,{{_,VertexList[gs[[1]]][[1,1,2]]}}],#2+{-.3,0},#2]&]@AssociationThread[VertexList[res]->Rescale@GraphEmbedding[res,"SpringEmbedding"]];addVertexFigures[res,lts,{2,2},EdgeStyle->Gray,VertexCoordinates->emb,VertexSize->.25]]
Out[]=
In[]:=
Module[{g0,gw,gs,joing,res1,res,lts,emb},g0=VertexReplace[NearestNeighborGraph[Keys[$LifetimeData[2,2,"Symmetric"]],{All,3/2},DistanceFunction->BinaryMutationDistance,VertexCoordinates->Automatic,GraphLayout->"SpringElectricalEmbedding"],x_:>{x}];gw=EvolutionaryMultiwayGraph[changeFitness[{2,2},$LifetimeData[2,2,"Symmetric"],Length@*First],GraphLayout->"LayeredDigraphEmbedding","Reduced"->True,AspectRatio->.6,EdgeStyle->Gray];res1=addVertexFigures[Subgraph[g0,List/@#],$LifetimeData[2,2,"Symmetric"],{2,2},EdgeStyle->Gray,GraphLayout->"SpringElectricalEmbedding",VertexSize->1/4,AspectRatio->2/3,ImageSize->Tiny]&/@Select[VertexList[gw],Length[#]>1&];gs=Map[ExpandLevelGraph[res1[[#]],VertexSize->1/2]&,{8,12}];joing=Graph[Catenate[Outer[If[SameQ[1,DigitCount[BitXor[SymmetricEncode[#1[[1,1]]],SymmetricEncode[#2[[1,1]]]],2,1]],DirectedEdge[#1,#2],Nothing]&,VertexList[gs[[1]]],VertexList[gs[[2]]],1]]];res=HighlightGraph[GraphUnion@@Append[gs,joing],joing];lts=Association[#->$LifetimeData[2,2,"All"][{BitAnd@@#,Last[#]}]&/@Catenate[VertexList[res]]];emb=KeyValueMap[#1->If[MatchQ[#1,{{_,VertexList[gs[[1]]][[1,1,2]]}}],#2+{-.3,0},#2]&]@AssociationThread[VertexList[res]->Rescale@GraphEmbedding[res,"SpringEmbedding"]];addVertexFigures[res,lts,{2,2},EdgeStyle->Gray,VertexCoordinates->emb,VertexSize->2]]

Randomness

Turing machines

Enumerating Multiway Case

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.