Thue-Morse Sequence

Author

Eric W. Weisstein
January 27, 2011

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/Thue-MorseSequence.nb.

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

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

Code

DigitSum[n_,b_:2]:=Total[IntegerDigits[n,b]]
t[n_]:=Mod[DigitCount[n,2,1],2]

Parity

Mod[Table[DigitCount[n,2,1],{n,0,31}],2]

Table[Mod[DigitSum[n,2],2],{n,0,31}]

1-Mod[Table[DigitCount[n,2,1],{n,0,31}],2]

Iterations

ThueMorse[n_,b_]:=NestList[Flatten[#/.{0->{0,1},1->{1,0}}]&,{b},n]

(Subscript[T, 0])

ThueMorse[5,0]//ColumnForm

FromDigits[#,2]&/@ThueMorse[5,0]

(Subscript[T, 1])

ThueMorse[5,1]//ColumnForm

FromDigits[#,2]&/@ThueMorse[5,1]

Binary Plot

<<Utilities`Plot`

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

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

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

Recurrence Plot

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

V5

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

ArrayPlot[Mod[Table[l[[x]]-l[[y]],{x,128},{y,128}],3],PixelConstrained->True,ColorRules->{0->Yellow,1->Green,2->Blue}]

V6

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

ArrayPlot[Mod[Table[l[[x]]-l[[y]],{x,128},{y,128}],3],PixelConstrained->True,ColorRules->{0->Yellow,1->Green,2->Blue}]

Digits

ThueMorse[5,0]

Transpose[Rest[Map[Length,(Split/@Sort/@(ThueMorse[5,0])),{-2}]]]

Products

t[0]

(∏_(n=0)^∞)(((((2 n+1)/(2 n+2))))^(((-1))^(Subscript[t, n])))==((Sqrt[2])/2)

Product[(((((2n+1)/(2n+2))))^(((-1))^(t[n]))),{n,0,10^4}]//N

(∏_(n=0)^∞)(((((2 n+1)/(2 n+2))))^(2(Subscript[t, n])))(((2n+3)/(2n+2)))==((2(Sqrt[2]))/π)

Product[(((((2n+1)/(2n+2))))^(2.t[n]))(((2n+3)/(2n+2))),{n,0,10^5}]

((2(Sqrt[2]))/π)//N

(∏_(n=0)^∞)(((((2 n+1)/(2 n+2))))^(2(1-(Subscript[t, n]))))(((2n+3)/(2n+2)))==((Sqrt[2])/π)

Product[(((((2n+1)/(2n+2))))^(2.(1-t[n])))(((2n+3)/(2n+2))),{n,0,10^5}]

((Sqrt[2])/π)//N

Primes

Position[FromDigits[#,2]&/@ThueMorse[20,1],_?PrimeQ]

Position[FromDigits[#,2]&/@ThueMorse[100,0],_?PrimeQ]

NKS Versions

Nest[Join[#,1-#]&,{1},7]

Table[1-Mod[DigitCount[n-1,2,1],2],{n,2^7}]

(CoefficientList[Product[1-z^(2^s),{s,0,7-1}],z]+1)/2

Flatten[CellularAutomaton[{69540422,2,2},{{1},0},2^7,{All,0}]]

Mod[CoefficientList[Series[(1+Sqrt[(1-3x)/(1+x)])/(2(1+x)),{x,0,2^7-1}],x],2]

Mod[Table[1/2(-1)^n+(-3)^n Sqrt[Pi] Hypergeometric2F1[3/2,-n,3/2-n,-1/3]/ (4n! Gamma[3/2-n]),{n,0,2^7-1}],2]