Plotting number of accurate digits as function of n

Mathematica program

(* Plotting number of accurate digits as function of n *)
maxtime = 66;

sect = "errors";
entity = "figure";

If[newfigure == True,
degrs = {0, 1, 2, 3, 4, 5, 6};
mdegrs = Length[degrs];
(***)
fileerr = "erralgap-"<>name<>".txt";
fileerrid = {};
If[FileType[fileerr] === File, Get[fileerr]];
If[fileerrid =!= fileid,
en = coeff[name];
Clear[erralgappr];
ndgs = 128 + 2 nm;
Do[degr = degrs[[ndegr]];
   {c0, cfrec} = algappr0[en, degr, ndigits -> ndgs];
   Print["Degree of appr. ", degr];
   ndegree = degr;
   ncoeff = nm;
   km = ndegree + 1;
   Clear[r, t];
x1 = 1;
Do[Do[r[k, n] = (-c0)^(n - k)*Binomial[n - 1, k - 1], {n, km}], {k, km}];
   errlist = {}; Do[
    na = n - km + 1;
    Do[a = x1*r[k, 1];
      Do[a = a + cfrec[[m, na]]*r[k, m + 1], {m, ndegree}];
      Do[r[k, m] = r[k, m + 1], {m, ndegree}];
      r[k, km] = a, {k, km}];
pol0 = Sum[r[n +1, km]*t^n, {n, 0, ndegree}];
TimeConstrained[solv = Solve[pol0 == 0, t], maxtime, Continue[]];
       res = t /. # & /@ solv;
Print["Algappr: ndegr=",ndegr," n=",n," exact=",enex," res=",res];
       err = Min[Table[Abs[res[[n]] - enex], {n, degr}]] // N;
       logerr = -Log[10, err];
       errlist = Append[errlist, {n, logerr}], {n, km, nm}];
   Print[errlist // Transpose // TableForm];
   erralgappr[degr] = errlist, {ndegr, 2, mdegrs}];
If[FileType[fileerr] === File, DeleteFile[fileerr]];
fileerrid = fileid;
Save[fileerr, {erralgappr,fileerrid}];
];
(***)
scale = 0.5 Sqrt[30./(15 + nm)];
rat = 1/GoldenRatio // N;
plts = {};
Do[degr = degrs[[ndegr]];
    errlist = If[degr === 0,
        Table[err = Abs[enex - Plus @@ Take[func, n]];
          logerr = -Log[10, err];
          {n, logerr}, {n, nm}], erralgappr[degr]];
    If[Length[errlist] > 2 && ! List @@ errlist == {name, degr}, 
      plt = MultipleListPlot[errlist, SymbolShape -> shape[degr],
          SymbolStyle -> {{AbsoluteThickness[1.2 scale], color[degr]}},
          PlotStyle -> {{AbsoluteThickness[1.2 scale], RGBColor[1, 0, 0]}},
          PlotJoined -> (degr === 0),
          DisplayFunction -> Identity];
      plts = Append[plts, plt]], {ndegr, mdegrs}];
plt = Show[plts, plt00, Frame -> True, 
      FrameLabel -> {"\!\(\* StyleBox[\"n\",\nFontFamily->\"Times\",\nFontSlant->\"Italic\"]\)", 
          "\!\(\* StyleBox[\"number\ \ \ \ of\ \ \ accurate\ \ \ digits\",\nFontFamily->\"Times\",\nFontSize->9]\)"},
      AspectRatio -> rat,
      PlotRange -> {{0, nm + 0.3}, All},
      AxesOrigin -> {0, 0}, 
      DisplayFunction -> If[ifexport, Identity, $DisplayFunction]];
outfile = ToFileName[dir, sect <> ".gif"];
If[ifexport, Export[outfile, plt, "GIF", ImageSize -> 320 {1, rat}, 
    ImageResolution -> 150]];
outfile1 = StringReplace[outfile, ".gif" -> ".pdf"];
plt1 = Show[plt, PlotRegion -> {{0.05, 0.95}, {0.05, 0.95}}, 
      DisplayFunction -> Identity];
If[ifexport, Export[outfile1, plt1, "PDF",
    ImageSize -> Automatic,
    (*ImageOffset -> Automatic,*)
    ImageRotated -> True]];
];

"<A NAME=\"" <> sect <> "\"></A><TABLE BORDER=1 CELLPADDING=8 CELLSPACING=0 BGCOLOR=\"#FFFFFF\"><TR><TD>" // p;
"<TABLE BORDER=0 CELLPADDING=8 BGCOLOR=\"#FFFFFF\">" // p;
"<TR ALIGN=\"CENTER\" VALIGN=\"MIDDLE\" BGCOLOR=\"#FEF8CB\"><TH>
Convergence of summation approximants for the M&#248;ller - Plesset series
<BR>measured in growth of number of accurate decimal digits of summation results
<BR> with increase of <I>n</I>, number of used coefficients.
<BR>The summation methods are <FONT COLOR=\"#FF0000\">partial sums</FONT> (red connected disks),
<BR><FONT COLOR=\"#0000FF\">Pade approximants</FONT> (blue circles),
<BR><FONT COLOR=\"#00FF00\">quadratic approximants</FONT> (green boxes),
<BR>cubic, quartic, fifth and sixth degree approximants
<BR>(triangles, diamonds, pentagonal and hexagonal stars respectively).
</TH></TR>" // p;
"<TR ALIGN=\"CENTER\" VALIGN=\"MIDDLE\"><TD>" <>
 "<IMG SRC=\"" <> sect <> ".gif?" <> 
      rndm <> "\" WIDTH=666 HEIGHT=412 ALT=\"Plot of number of accurate digits\"></TD></TR>" <> "</TABLE></TD></TR></TABLE>" // p;
printprogr[sect]; printnav;

Molecule - icon for Allen-dataBlankExamples of MP seriesBlankSource code of Mathematica programBlankMathematica programsBlankWork in UMass DartmouthWork in UMassDBlankWaste iconUnpublished reports

Designed by A. Sergeev.