Thue-Morse Constant

Author

Eric W. Weisstein
August 27, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Constants/Thue-MorseConstant.nb.

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

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

Code

ThueMorse[n_,b_]:=Nest[Flatten[#/.{0->{0,1},1->{1,0}}]&,{b},n]
DigitSum[n_,b_:2]:=Total[IntegerDigits[n,b]]

Numerical

ThueMorse[5,0]

ThueMorse[5,1]

N[Total[Table[Mod[DigitCount[k,2,1],2]/2^k,{k,1000}]],20]

BaseForm[%,2]

N[FromDigits[{ThueMorse[12,#],0},2],20]&/@{0,1}

BaseForm[0.58754596635989240221663863174154471691`20.,2]

With[{prec=1000},Module[{n=Ceiling[Log[2,prec]prec/2]},N[FromDigits[Table[Mod[DigitSum[k,2],2],{k,0,n}],2]/2^(n+1),prec]]]

Recurrence

Factor[an+(1-2^(-2^n)-an)2^(-2^n)]

a[0]:=0
a[n_]:=a[n]=2^(-2^n)(2^(2^(n-1))-1)(1+2^(2^(n-1))a[n-1])

Table[a[n],{n,0,5}]

v5.0

soln=RSolve[{a[n+1]==(2^(-(2^(1+n)))) (-1+(2^(2^n))) (1+(2^(2^n)) a[n]),a[0]==0},a[n],n]

FullSimplify[soln]

soln2=RSolve[{a[n+1]==(2^(-(2^(1+n)))) (-1+(2^(2^n))) (1+(2^(2^n)) a[n]),a[0]==0,a[1]==1/4},a[n],n]

Table[a[n]/.soln[[1]]/.{K$636->0,K$549->0},{n,0,3}]

Table[a[n]/.soln[[1]]/.{K$636->1,K$549->2},{n,0,3}]

2^(-2^n)(2^(2^(n-1))-1)(1+2^(2^(n-1))a[n-1])/.{a[n-1]->0,n->1}

sol={a -> Function[{n}, (-Product[(-1 + 2^2^K$31)/2^2^K$31, 
        {K$31, K$32, -1 + n}])*Sum[(-1 + 2^2^K$127)/
        (2^2^(1 + K$127)*Product[(-1 + 2^2^K$31)/2^2^K$31, 
          {K$31, K$32, K$127}]), {K$127, K$128, -1}] + 
     Product[(-1 + 2^2^K$31)/2^2^K$31, {K$31, K$32, 
        -1 + n}]*Sum[(-1 + 2^2^K$127)/(2^2^(1 + K$127)*
         Product[(-1 + 2^2^K$31)/2^2^K$31, {K$31, K$32, 
           K$127}]), {K$127, K$128, -1 + n}]]};

Table[a[n]/.sol/.{K$32->0,K$128->0},{n,0,3}]

Table[a[n]/.sol/.{K$32->1,K$128->0},{n,0,3}]

Table[a[n]/.sol/.{K$32->2,K$128->0},{n,0,3}]

Table[a[n]/.sol/.{K$32->0,K$128->1},{n,0,3}]

Table[a[n]/.sol/.{K$32->1,K$128->2},{n,0,3}]

V7

soln=RSolve[{a[n+1]==(2^(-(2^(1+n)))) (-1+(2^(2^n))) (1+(2^(2^n)) a[n]),a[0]==0},a[n],n]

Explicit values

Table[FromDigits[{ThueMorse[n],0},2],{n,5}]

N[%]

Table[{a[n],RealDigits[a[n],2]},{n,0,4}]//ColumnForm

tm=Table[a[n],{n,0,20}];

Take[tm,5]//InputForm

Product

Table[(2^(2^n)),{n,0,6}]

Table[(((2^(2^n))-1)/(2^(2^n))),{n,0,6}]

(1/4)(2-Product[(((2^(2^n))-1)/(2^(2^n))),{n,0,∞}])

N[(1/4)(2-Product[(((2^(2^n))-1)/(2^(2^n))),{n,0,20}]),200]

N[(1/4)(2-Product[(((2^(2^n))-1)/(2^(2^n))),{n,0,21}]),200]

(1/4)(2-NProduct[(((2^(2^n))-1)/(2^(2^n))),{n,0,∞}])

(1/4)(2-NProduct[1-(1/(2^(2^n))),{n,0,∞}])

V10

$Version

(1/4)(2-Product[(((2^(2^n))-1)/(2^(2^n))),{n,0,∞}])

(1/4)(2-Product[1-(1/(2^(2^n))),{n,0,∞}])

Continued Fraction

(1/(3-(1/(2+ContinuedFractionK[1-(2^(2^(n-1))),(2^(2^n)),{n,∞}]))))

N[(1/(3-(1/(2+ContinuedFractionK[1-(2^(2^(n-1))),(2^(2^n)),{n,25}])))),200]

BBP-Type Formulas

ThueMorse=N[(1/4)(2-Product[(((2^(2^n))-1)/(2^(2^n))),{n,0,20}]),1000]

Search

<<Utilities`Simplify`

Monitor[Do[If[(b=FindBasis[ThueMorse,-3^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,1}],{-3^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-3^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,2,2}],{-3^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-3^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,3,3}],{-3^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-2^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,1}],{-2^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-2^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,2,2}],{-2^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-2^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,3,3}],{-2^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-1,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,0,0},{n,64},{p,1}],{-1,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-1,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,0,0},{n,64},{p,2,2}],{-1,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,-1,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,0,0},{n,64},{p,3,3}],{-1,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,1,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,0,0},{n,64},{p,2,2}],{1,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,1,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,0,0},{n,64},{p,3,3}],{1,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,2^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,1}],{2^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,2^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,2,2}],{2^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,2^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,3,3}],{2^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,3^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,1}],{3^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,3^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,2,2}],{3^k,n,p}];//Timing

Monitor[Do[If[(b=FindBasis[ThueMorse,3^k,n,BasisPower->p,WorkingPrecision->300])=!={},Print[b]],{k,16},{n,64},{p,3,3}],{3^k,n,p}];//Timing