(*Other program:For large calculations.Tested for 1000-35000 digits-- see post at http://community.wolfram.com/groups/-/m/t/366628?p_p_auth=KA7y1gD4 and search for "analog" to find pertinent replies.This program designed to calculate up to 40000 digits (see remark after If[prec>35000,d=Ceiling[0.002 prec]),but might require more than 64GB RAM.A157852 is saved as c,the real part as a and the imaginary part as b.*)Block[{$MaxExtraPrecision=200},prec=40000(*Replace 40000 with number of desired digits.40000 digits should take two weeks on a 3.5 GH Pentium processor.*);f[x_]=x^(1/x);
ClearAll[a,b,h];
Print[DateString[]];
Print[T0=SessionTime[]];
If[prec>35000,d=Ceiling[0.002 prec](*If 0.002 prec leaves an error for any calculation over 35,000 digits try 0.0025 prec.More than 40,000 digits will probably require a bigger percentage of prec.*),d=Ceiling[0.264086+0.00143657 prec]];
h[n_]:=Sum[StirlingS1[n,k]*Sum[(-j)^(k-j)*Binomial[k,j],{j,0,k}],{k,1,n}];
h[0]=1;
g=2 I/Pi-Sum[-I^(n+1) h[n]/Pi^(n+1),{n,1,d}];
sinplus1:=NIntegrate[Simplify[Sin[Pi*x]*D[f[x],{x,d+1}]],{x,1,Infinity},WorkingPrecision->prec*(105/100),PrecisionGoal->prec*(105/100)];
cosplus1:=NIntegrate[Simplify[Cos[Pi*x]*D[f[x],{x,d+1}]],{x,1,Infinity},WorkingPrecision->prec*(105/100),PrecisionGoal->prec*(105/100)];
middle:=Print[SessionTime[]-T0," seconds"];
end:=Module[{},Print[SessionTime[]-T0," seconds"];
Print[c=Abs[a+b]];Print[DateString[]]];
If[Mod[d,4]==0,Print[N[a=-Re[g]-(1/Pi)^(d+1)*sinplus1,prec]];
middle;
Print[N[b=-I (Im[g]-(1/Pi)^(d+1)*cosplus1),prec]];
end];
If[Mod[d,4]==1,Print[N[a=-Re[g]-(1/Pi)^(d+1)*cosplus1,prec]];
middle;
Print[N[b=-I (Im[g]+(1/Pi)^(d+1)*sinplus1),prec]];end];
If[Mod[d,4]==2,Print[N[a=-Re[g]+(1/Pi)^(d+1)*sinplus1,prec]];
middle;
Print[N[b=-I (Im[g]+(1/Pi)^(d+1)*cosplus1),prec]];
end];
If[Mod[d,4]==3,Print[N[a=-Re[g]+(1/Pi)^(d+1)*cosplus1,prec]];
middle;
Print[N[b=-I (Im[g]-(1/Pi)^(d+1)*sinplus1),prec]];
end];] (*Marvin Ray Burns,Aug 06 2015*)