Plotting number of accurate digits as function of n

Mathematica program

(* Plotting number of accurate digits as function of n *)

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

shape[0] := MakeSymbol[Disk[{0, 0}, Offset[5 scale{1, 1}]]];(*partial sums*)
shape[1] := 
    MakeSymbol[
      Circle[{0, 0}, Offset[6 scale{1, 1}]]];(*linear (Pade) approximants*)
shape[2] := PlotSymbol[Box, 5 scale];(*quadratic*)
shape[3] := PlotSymbol[Triangle, 6 scale];(*cubic*)
shape[4] := PlotSymbol[Diamond, 6 scale];(*quartic*)
shape[5] := PlotSymbol[Star, 6 scale];(*5th order*)
shape[6] := 
    MakeSymbol[{RegularPolygon[6, 6 scale, {0, 0}, 0, 2], 
        RegularPolygon[6, 6 scale, {0, 0}, Pi/3, 2]}];(*6th order*)
color[n_] := RGBColor[0, 0, 0];
color[0] := RGBColor[1, 0, 0];
color[1] := RGBColor[0, 0, 1];
color[2] := RGBColor[0, 1, 0];
If[newfigure == True,
degrs = {0, 1, 2, 3, 4, 5, 6};
Get["erralgap.txt", Path -> {"C:\\sergeev\\umassd\\math\\series"}];
scale = 0.5 30./(15 + nm);
mdegrs = Length[degrs];
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[name, 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, plt0, 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 -> Identity];
outfile = ToFileName[dir, sect <> ".gif"];
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];
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 Moller - 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;

All Mathematica programs used to study M. - P. series Blank Work in UMassD BlankWaste icon Unpublished reports

Designed by A. Sergeev.