Soldner’s Constant Digits

Author

Eric W. Weisstein
October 7, 2013

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Constants/SoldnersConstantDigits.nb.

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

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

Computation

SetDirectory["/Developer/eww"];

Compute

Efficient computation

From Michael Trott, Sep. 17, 2013

Using some high-order Newton method generalization you could cut down the steps and function evaluations considerably.

stepN[x_Real]:=With[{f=LogIntegral[x]},x-((f ((1/((Log[x])^2))+(f/(2 x ((Log[x])^2)))))/((1/((Log[x])^3))+((LogIntegral[x])/(x ((Log[x])^3)))+(1/6) ((2/((x^2) ((Log[x])^3)))+(1/((x^2) ((Log[x])^2)))) (f^2)))]

16 4^8

fr=FindRoot[LogIntegral[x]==0, {x, 3/2}, PrecisionGoal -> 15, WorkingPrecision -> 25]

x[1] = SetPrecision[1.4513, 40];

x[2]=stepN[x[1]]; δ[2]=N[LogIntegral[x[2]], 18]

x[2]= SetPrecision[x[2], 4.5 Abs[Log10[Abs[δ[2]]]]]

x[3]=stepN[x[2]]; δ[3]=N[LogIntegral[x[3]], 3]

x[3]= SetPrecision[x[3], 4.5 Abs[Log10[Abs[δ[3]]]]]

x[4]=stepN[x[3]]; δ[4]=N[LogIntegral[x[4]], 3]

x[4]= SetPrecision[x[4], 4.5 Abs[Log10[Abs[δ[4]]]]]

x[5]=stepN[x[4]]; δ[5]=N[LogIntegral[x[5]], 3]

x[5]= SetPrecision[x[5], 4.5 Abs[Log10[Abs[δ[5]]]]];

x[6]=stepN[x[5]]; δ[6]=N[LogIntegral[x[5]], 3]

x[6]= SetPrecision[x[6], 4.5 Abs[Log10[Abs[δ[6]]]]];

x[7]=stepN[x[6]]; δ[7]=N[LogIntegral[x[6]], 3]

Compare methods

Plot[LogIntegral[x],{x,0,2}]

μ=Reduce[LogIntegral[x]==0&&14/10<x<15/10,x,Reals][[2]]

Precision[cons1=N[μ,10^3]]//Timing

Precision[cons2=FindRoot[LogIntegral[x]==0,{x,1.451369234883381,1.45,1.46},WorkingPrecision->10^3][[1,2]]]//Timing

cons1==cons2

(10^4)

Precision[cons=FindRoot[LogIntegral[x]==0,{x,1.451369234883381,1.45,1.46},WorkingPrecision->10^4+10][[1,2]]]//Timing

N[cons]

DumpSave["/Developer/eww/Constants/Soldner_10_4.mx",cons];

StringLength[string=StringTake[ToString[cons],{3,-3}]]//Timing

DumpSave["/Developer/eww/DigitStrings/Soldner_10_4.mx",string];

(10^5)

{$MachineName,$TopDirectory,DateString[],$Version}//Column

Precision[cons=FindRoot[LogIntegral[x]==0,{x,1.451369234883381,1.45,1.46},WorkingPrecision->10^5+10][[1,2]]]//Timing

N[cons]

DumpSave["/Developer/eww/Constants/Soldner_10_5.mx",cons];

StringLength[string=StringTake[ToString[cons],{3,-3}]]//Timing

DumpSave["/Developer/eww/DigitStrings/Soldner_10_5.mx",string];

Get["Constants/Soldner_10_5.mx"];

Length[realdigits=RealDigits[cons,10][[1]]]//Timing

DumpSave["/Developer/eww/RealDigits/Soldner_10_6.mx",realdigits];

(10^6)

{$MachineName,$TopDirectory,DateString[],$Version}//Column

Precision[cons=FindRoot[LogIntegral[x]==0,{x,1.451369234883381,1.45,1.46},WorkingPrecision->10^6+10][[1,2]]]//Timing

N[cons]

DumpSave["/Developer/eww/Constants/Soldner_10_6.mx",cons];

StringLength[string=StringTake[ToString[cons],{3,-3}]]//Timing

DumpSave["/Developer/eww/DigitStrings/Soldner_10_6.mx",string];

Length[realdigits=RealDigits[cons,10][[1]]]//Timing

DumpSave["/Developer/eww/RealDigits/Soldner_10_6.mx",realdigits];

(10^7)

{$MachineName,$TopDirectory,DateString[],$Version}//Column

Precision[cons=FindRoot[LogIntegral[x]==0,{x,1.451369234883381,1.45,1.46},WorkingPrecision->10^7+10][[1,2]]]//Timing

N[cons]

DumpSave["Constants/Soldner_10_7.mx",cons];

StringLength[string=StringTake[ToString[cons],{3,-3}]]//Timing

DumpSave["DigitStrings/Soldner_10_7.mx",string];

Length[realdigits=RealDigits[cons,10][[1]]]//Timing

DumpSave["RealDigits/Soldner_10_7.mx",realdigits];

Digit Distribution

StringLength[string]

StringPartition[s_String,chunksize_]:=Module[{len=StringLength[s],k},If[chunksize>len,{s},StringTake[s,#]&/@Table[{1+(k-1) chunksize,Min[len,k chunksize]},{k,Ceiling[len/chunksize]}]]]

BigStringCount[s_,c_,chunksize_:((2^31)-1)]:=Total[StringCount[#,c]&/@StringPartition[s,chunksize]]

(digits=Table[{n,BigStringCount[StringTake[string,10^n],#]&/@CharacterRange["0","9"]},{n,Floor[Log10[StringLength[string]]]}])//Timing

Grid[digits,Dividers->All,Alignment->Left]

MapIndexed[{#2[[1]]-1,#}&,Transpose[digits[[All,2]]]]

Digit Runs

k n’s

StringLength[string]

(data=Flatten[Table[{d,n,If[#=={},0,First[#]]&/@StringPosition[string,StringJoin@@Table[ToString[d],{n}],10]},{d,0,9},{n,10}],1])//Timing

Grid[DeleteCases[data,{_,_,{}}],Dividers->All,Alignment->Left]

n n’s (Earls Sequence)

A229071

StringLength[string]

earls=Cases[DeleteCases[data,{_,_,{}}],{x_,x_,s_}:>{x,s[[1]]}]

earls[[All,2]]

Length[earls]

Scan until all n-digits strings have been found

?ScanDigitStrings

A000000/A000000

Length[realdigits=RealDigits[cons,10][[1]]]//Timing

Do[Print[{n,ScanDigitStrings[realdigits,n]//Timing}],{n,6}]

First digit string occurrences

A229201

Length[realdigits]

Length[f=FirstDigitOccurrences[realdigits,6]]//Timing

Take[f,100]

Take[Position[f,0],10]//Flatten

<<Utilities`EISFormat`

BFile["~/b229201.txt",Position[f,0,1,1][[1]],0]

Specific Digits Runs

StringLength[string]

0123456789

StringPosition[string,"0123456789"][[All,1]]//Timing

9876543210

StringPosition[string,"9876543210"][[All,1]]//Timing