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