du Bois-Reymond Constants

Author

Eric W. Weisstein
February 18, 2015

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Constants/duBois-ReymondConstants.nb.

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

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

Code (Old)

DuBoisRaymond[n_,t_]:=D[(Sin[t]/t)^n,t]

root[0]:=0
root[1]:=Module[{t},t/.FindRoot[Tan[t]-t,{t,4.5}]]
root[n_]:=root[n]=Module[{t},
t/.FindRoot[Tan[t]-t,{t,root[n-1]+Pi},MaxIterations->20,WorkingPrecision->30]
]

db[num_,k_Integer?EvenQ]:=Module[{l,n,t},
t=Timing[l=2 (Sin[#]/#)^k&/@Table[root[n],{n,num}]][[1]];
{num,t,Plus@@l,SequenceLimit[FoldList[Plus,0,l]]}
]

db[num_,k_Integer?OddQ]:=Module[{r,n,t,d,l},
d=DuBoisRaymond[k,t];
r=Table[root[n],{n,num}];
allroots=Sort[Join[r,Table[n Pi,{n,Floor[Last[r]/Pi]}]],Less];
t=Timing[l=NIntegrate[Abs[d],Evaluate[{t,Sequence@@#}]]&/@Partition[allroots,2,1]][[1]];
{num,t,Plus@@l,SequenceLimit[FoldList[Plus,0,l]]}
]

Clear[root,rootExtrapolated,rootNewton,rootCompiled];

eps=10.^(-12);

cf=Compile[t,t-Tan[t]];

root[0]:=0
root[1]:=Module[{t},
t/.FindRoot[Tan[t]-t,{t,4.5}]
]
root[n_]:=root[n]=Block[{t},
t/.FindRoot[t==Tan[t],Evaluate[{t,root[n-1]+Pi,(2n +1)Pi/2-eps}]]
] 

rootCompiled[0]:=0
rootCompiled[1]:=root[1]
rootCompiled[n_]:=rootCompiled[n]=Module[{t},
t/.FindRoot[cf[t],Evaluate[{t,rootCompiled[n-1]+Pi,(2n +1)Pi/2-eps}],Compiled->False]
] 

rootExtrapolated[0]:=root[0]
rootExtrapolated[1]:=root[1]
rootExtrapolated[n_]:=rootExtrapolated[n]=Module[{t},
t/.FindRoot[Tan[t]-t,Evaluate[{t,(2n +1)Pi/2-.317739/n,(2n +1)Pi/2-eps}]]
] 

rootNewton[0]:=root[0]
rootNewton[1]:=root[1]
rootNewton[n_]:=rootNewton[n]=Module[{t},
t/.FindRoot[Tan[t]-t,Evaluate[{t,rootNewton[n-1]+Pi}]]
]

Functions

FullSimplify[DuBoisRaymond[n,t]]

FullSimplify[Table[DuBoisRaymond[n,t],{n,3}]]//ColumnForm

Plot

<<Graphics`Colors`

MakeBoxes[ordinate,TraditionalForm]:=RowBox[{"|",RowBox[{FractionBox["d",RowBox[{"d"," ","t"}]],SuperscriptBox[RowBox[{"(",FractionBox[RowBox[{"sin","t"}],"t"],")"}],"n"]}],"|"}]

ordinate//TraditionalForm

Plot[Evaluate[Abs[Table[DuBoisRaymond[n,t],{n,5}]]],{t,0,10},PlotStyle->{Red,Yellow,Green,Blue,Violet},
AxesLabel->TraditionalForm/@{t,ordinate},
PlotRange->All]

(Subscript[C, 2n])

Residue[((x^2)/((((1+(x^2)))^n)(Tan[x]-x))),{x,I}]

(Subscript[C, 1]) (diverges)

r=t/.FindInstance[t-Tan[t]==0&&4<t<5,t,Reals][[1]]

D[Sin[t]/t,t]

To 1st zero

Integrate[Abs[Cos[t]/t-Sin[t]/t^2],{t,0,4.49341}]

Integrate[Abs[Cos[t]/t-Sin[t]/t^2],{t,0,N[r]}]

Integrate[Abs[Cos[t]/t-Sin[t]/t^2],{t,0,r}]

FullSimplify[%]

N[%]

Complete interval

Integrate[Abs[Cos[t]/t-Sin[t]/t^2],{t,0,∞}]//Timing

NIntegrate[Abs[Cos[t]/t-Sin[t]/t^2],{t,0,∞}]//Timing

Sum

root/@Range[5]

db[20,1]

(Subscript[C, 2])

Integrate[Abs[DuBoisRaymond[2,t]],{t,0,∞}]-1

Abs[DuBoisRaymond[2,t]]//InputForm

db[20,2]

db[100,2]

NIntegrate[Abs[DuBoisRaymond[2,t]],{t,0,∞},MaxRecursion->25]-1

Root Sinc Sum

(10^3)

data=N[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]}]^2,100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(10^4)

data=N[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1*^4,x]]}]^2,100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

Root Power Sum

(10^3)

data=N[(((1+((x^2)/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]})))^(-2/2)),100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(10^4)

data=N[(((1+((x^2)/.{ToRules[Reduce[Tan[x]==x&&0<x<1*^4,x]]})))^(-2/2)),100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

Residue

-4-2Residue[((x^2)/((1+(x^2))(Tan[x]-x))),{x,I}]//FullSimplify

N[%,20]

(Subscript[C, 3])

NIntegrate[Abs[DuBoisRaymond[3,t]],{t,0,100},WorkingPrecision->20,MaxRecursion->20]-1

pts=Partition[Prepend[SortBy[t/.{ToRules[Reduce[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))==0&&0<=t<100,t]]},N],0],2,1];

Take[pts,2]

NIntegrate[Abs[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))],Evaluate@{t,Sequence@@#}]&/@Take[pts,2]

Integrate[Abs[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))],Evaluate@{t,Sequence@@#}]&/@Take[pts,2]

pts=Partition[SortBy[t/.{ToRules[Reduce[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))==0&&0<=t<100,t]]},N],2,1];

l=NIntegrate[Abs[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))],Evaluate@{t,Sequence@@#}]&/@Take[pts,6]

Values are the same in adjacent intervals, so only need one of the pair

pts=Partition[SortBy[t/.{ToRules[Reduce[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))==0&&0<=t<100,t]]},N],2,1][[1;;All;;2]];

Integrate[Abs[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))],Evaluate@{t,Sequence@@#}]&/@Take[pts,2]//FullSimplify

N[%]

-(((Sin[Root[{Sin[#1]-Cos[#1] #1&,7.725251836937707164195088246191550743476468565923141946867`23.602059968206216 }]])^3)/((Root[{Sin[#1]-Cos[#1] #1&,7.725251836937707164195088246191550743476468565923141946867`23.602059968206216 }])^3))

N[%]

n=0;l=Monitor[(n++;NIntegrate[Abs[((3 Cos[t] ((Sin[t])^2))/(t^3))-((3 ((Sin[t])^3))/(t^4))],Evaluate@{t,Sequence@@#}])&/@Take[pts,10],n]

2Total[%]

Root Power Sum

(10^3)

data=N[(((1+((x^2)/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]})))^(-3/2)),100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(10^4)

data=N[(((1+((x^2)/.{ToRules[Reduce[Tan[x]==x&&0<x<1*^4,x]]})))^(-3/2)),100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

Root Sinc Sum

Reduce[Tan[x]==x&&0<x<20,x]

(10^3)

data=N[Abs[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]}]^3],50];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(10^4)

data=N[Abs[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<10^4,x]]}]^3],50];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

2*^4

data=N[Abs[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<2*^4,x]]}]^3],50];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

Numerically close

N[-(13/120)E+(37/30)-(7/60)(E^2),20]/E

(Subscript[C, 4])

Integral

NIntegrate[Abs[DuBoisRaymond[4,t]],{t,0,∞},MaxRecursion->25]-1

Residue

-3-2Residue[((x^2)/((((1+(x^2)))^2)(Tan[x]-x))),{x,I}]//FullSimplify

N[%,20]

Root Power Sum

(10^3)

data=N[(((1+((x^2)/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]})))^(-2)),100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(10^4)

data=N[(((1+((x^2)/.{ToRules[Reduce[Tan[x]==x&&0<x<1*^4,x]]})))^(-2)),100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

Root Sinc Sum

(10^3)

data=N[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]}]^4,100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(Subscript[C, 5])

Integral

NIntegrate[Abs[DuBoisRaymond[5,t]],{t,0,100},WorkingPrecision->20,MaxRecursion->20]-1

Root Sinc Sum

data=N[Abs[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]}]^5],50];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(Subscript[C, 6])

Integral

NIntegrate[Abs[DuBoisRaymond[6,t]],{t,0,∞},MaxRecursion->25]-1

Residue

-3-2Residue[((x^2)/((((1+(x^2)))^3)(Tan[x]-x))),{x,I}]//FullSimplify

N[%,20]

Root Sinc Sum

(10^3)

data=N[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1000,x]]}]^6,100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

(10^4)

data=N[Sinc[x/.{ToRules[Reduce[Tan[x]==x&&0<x<1*^4,x]]}]^6,100];//Timing

2Total[data]

2SequenceLimit[Accumulate@data]

Residues

v=Together/@TrigToExp[-Table[3+KroneckerDelta[1,n]+2Residue[x^2/(1+x^2)^n/(-x+Tan[x]),{x,I}],{n,9}]];//Timing

Take[v,5]//Column//TraditionalForm

N[v]

Denominator[v]

c=Reverse[CoefficientList[#,E^2]]&/@Numerator[v]