Mephisto Waltz Sequence

Author

Eric W. Weisstein
April 10, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/MephistoWaltzSequence.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/MephistoWaltzSequence.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Generation

StringJoin@@@(Flatten/@NestList[#/.{"0"->{"0","0","1"},"1"->{"1","1","0"}}&,{"0"},3])

Flatten[Nest[#/.{0->{0,0,1},1->{1,1,0}}&,{0},3]]

Binary Plot

<<Utilities`Plot`

l=Flatten[Nest[#/.{0->{0,0,1},1->{1,1,0}}&,{0},10]];

ll=Reverse[NestList[Most,Take[l,256],255]];

ArrayPlot[NaryPlot[FromDigits[#,2]&/@ll],PixelConstrained->True]

Recurrence Plot

ArrayPlot[Mod[Table[l[[x]]-l[[y]],{x,128},{y,128}],2],PixelConstrained->True]

Digits

Transpose[Rest[Map[Length,(Split/@Sort/@(Flatten/@NestList[#/.{0->{0,0,1},1->{1,1,0}}&,{0},5])),{-2}]]]

(3^Range[0,5]+# 1)/2&/@{1,-1}