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 »
WOLFRAM NOTEBOOK
In[]:=
GenerationalMultiwaySystem[{"A""AA","A""B"},{"BA"},4];
In[]:=
StringReplace[#,"AA""C"]&/@%;
In[]:=
ToNumbers[s_]:=FromDigits[(Characters[#]/.{"C"0,"B"1}),2]&/@s
In[]:=
ToNumbers/@%;
In[]:=
Rest[%]
Out[]=
In[]:=
Length/@%
Out[]=
{2,5,24,455}
In[]:=
Length/@%
Out[]=
{2,5,24}
In[]:=
Max[StringLength/@#]&/@GenerationalMultiwaySystem[{"A""AA","A""B"},{"A"},4]
Out[]=
{1,2,4,8,16}
{1,2,5,24,455,128702}
In[]:=
Table[2^2^(t-1),{t,5}]
Out[]=
{2,4,16,256,65536}
Ed’s code
Ed’s code
In[]:=
4^11
Out[]=
4194304
In[]:=
replaceBinaryZeros[integer_]:=Module[{binary,zerocount,zeroplace},binary=IntegerDigits[integer,2];zerocount=Count[binary,0];If[zerocount>10,Return["4194304+"]];zeroplace=Flatten[Position[binary,0]];Table[FromDigits[Flatten[ReplacePart[binary,Rule@@@Transpose[{zeroplace,IntegerDigits[IntegerDigits[k,4,zerocount],2,2]}]]],2],{k,0,4^zerocount-1}]];
Sort[FromDigits[IntegerDigits[ToExpression[#]],2]&/@#]&/@GenerationalMultiwaySystem[{"0""11","0""00","0""01","0""10"},{"10"},3,"AllStatesList"];
In[]:=
stage4={7,15,19,23,25,27,28,29,30,31,33,35,37,39,41,43,45,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,67,71,73,75,76,77,78,79,83,87,89,91,92,93,94,95,97,99,100,101,102,103,105,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,129,131,132,133,134,135,137,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,161,163,164,165,166,167,169,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511};
In[]:=
missing4=Complement[Range[2^9-1],stage4]
Out[]=
{1,2,3,4,5,6,8,9,10,11,12,13,14,16,17,18,20,21,22,24,26,32,34,36,38,40,42,44,46,64,65,66,68,69,70,72,74,80,81,82,84,85,86,88,90,96,98,104,106,128,130,136,138,160,162,168,170}
In[]:=
Length[missing4]
Out[]=
57
In[]:=
57/(2^9-1)//N
Out[]=
0.111546
In[]:=
stage5=Union[Flatten[replaceBinaryZeros[#]&/@stage4]];
In[]:=
Length[stage5]
Out[]=
128701
In[]:=
Last[stage5]
Out[]=
131071
In[]:=
2^17-1
Out[]=
131071
In[]:=
missing5=Complement[Range[2^17-1],stage5];
In[]:=
Length[missing5]
Out[]=
2370
In[]:=
2^(2^(6-1)+1)-1
Out[]=
8589934591
In[]:=
2^(2^(4-1)+1)-1
Out[]=
511
In[]:=
2^(2^(5-1)+1)-1
In[]:=
Last[missing5]
Out[]=
43690
In[]:=
ArrayPlot[Transpose[IntegerDigits[#,2,19]&/@Take[missing5,-400]],PixelConstrained2,FrameFalse]
Out[]=
In[]:=
IntegerDigits[43690,2]
Out[]=
{1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0}
In[]:=
2370/(2^17-1)//N
Out[]=
0.0180818
In[]:=
FromDigits[{1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0},2]
Out[]=
11184810
In[]:=
ListLogPlot[Differences[missing5]]
Out[]=
[ SW ]
[ SW ]