(* 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ø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; |
Designed by A. Sergeev.