Plotting scaled coefficients for each example

Mathematica program

(* Plotting scaled coefficients for each example *)

sect = "cplots";
entity = "figure";
savefile = "\\temp\\saveabc.dat";
Get[savefile];
c = asave[name];
b = bsave[name];
mean = csave[name];
If[!NumberQ[c] || !NumberQ[b] || !NumberQ[mean] || newabc == True,
goodness[bx_, cx_] := (ensc = Table[Abs[func[[n]]/cx^n/n^bx], {n, 3, nm}];
      men = Length[ensc];
      mean = (Plus @@ ensc)/men;
      scal = Max[ensc];
      mean/scal);
mtrial = 30;
cmax = 5;
bmax = 20;
goodtab = Table[c = cmax^(m/mtrial);
      b = bmax n/mtrial;
      {{b, c}, goodness[b, c]}, {m, -mtrial, mtrial}, {n, -mtrial, mtrial}];
goodtab = Flatten[goodtab, 1];
{b0, c0} = Sort[goodtab, #1[[2]] > #2[[2]] &][[1, 1]];
Print[{b0, c0} // N];
b1 = b0 + bmax(1/mtrial);
c1 = c0 cmax^(1/mtrial);
s = FindMinimum[-goodness[bx, cx], {bx, b0, b1}, {cx, c0, c1}, 
      MaxIterations -> 111];
Print[s];
{b0, c0} = {bx, cx} /. s[[2]];
Print[{b0, c0} // N];
(*Refining step*)
goodtab = Table[c = c0 cmax^(1/mtrial^(3/2));
      b = b0 + bmax(n/mtrial^(3/2));
      {{b, c}, goodness[b, c]}, {m, -mtrial, mtrial}, {n, -mtrial, mtrial}];
goodtab = Flatten[goodtab, 1];
{b0, c0} = Sort[goodtab, #1[[2]] > #2[[2]] &][[1, 1]];
Print[{b0, c0} // N];
b1 = b0 + bmax(1/mtrial^(3/2));
c1 = c0 cmax^(1/mtrial^(3/2));
s = FindMinimum[-goodness[bx, cx], {bx, b0, b1}, {cx, c0, c1}, 
      MaxIterations -> 111];
Print[s];
{b, c} = {bx, cx} /. s[[2]];
mean = Sum[Abs[func[[n]]/n^b/c^n], {n, 2, nm}]/(nm-1);
Clear[asave, bsave, csave];
asave[name] = c;
bsave[name] = b;
csave[name] = mean;
Save[savefile, {asave, bsave, csave}]
   ];

If[newfigure == True,
enplus = enminus = enall = {};
Do[ener = func[[n]]/n^b/c^n/mean;
    enall = Append[enall, {n, ener}];
    If[ener >= 0, enplus = Append[enplus, {n, ener}]];
    If[ener < 0, enminus = Append[enminus, {n, ener}]], {n, 2, nm}];
rat = 1/GoldenRatio // N;
pntsz = 0.015 Sqrt[30/(15 + nm)];
pltplus = 
    If[Length[enplus] == 0, {}, 
      ListPlot[enplus, PlotStyle -> {RGBColor[1, 0, 0], PointSize[pntsz]}, 
        AxesOrigin -> {0, 0}, DisplayFunction -> Identity]];
pltminus = 
    If[Length[enminus] == 0, {}, 
      ListPlot[enminus, PlotStyle -> {RGBColor[0, 0, 1], PointSize[pntsz]}, 
        AxesOrigin -> {0, 0}, DisplayFunction -> Identity]];
pltall = ListPlot[enall, PlotStyle -> {Thickness[pntsz/4], RGBColor[0.5, 0.5, 0.5]}, PlotJoined -> True,
      DisplayFunction -> Identity];
plt = Show[pltall, plt00, pltplus, pltminus, 
      AxesLabel -> {"\!\(\* StyleBox[\"n\",\nFontFamily->\"Times\",\nFontSlant->\"Italic\"]\)", 
          "\!\(\* StyleBox[ FractionBox[ StyleBox[\(E\_n\),\nFontFamily->\"Times\"],  \
StyleBox[\(c\\ n\^\(\(\\ \)\(b\)\)\\ a\^\(\(\\ \)\(n\)\)\),\n\
FontFamily->\"Times\"]],\nFontSlant->\"Italic\"]\)"},
      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,
    ImageRotated -> True]];
];

"<A NAME=\"" <> sect <> "\"></A><TABLE BORDER=1 CELLPADDING=8 CELLSPACING=0 BGCOLOR=\"#FFFFFF\"><TR><TD>
<TABLE BORDER=0 CELLPADDING=8 BGCOLOR=\"#FFFFFF\">
<TR ALIGN=\"CENTER\" VALIGN=\"MIDDLE\" BGCOLOR=\"#FEF8CB\"><TH>
Scaled coefficients of M&#248;ller-Plesset perturbation theory.\n
<BR>Parameters <I>a</I>&nbsp;=&nbsp;"<>printF[c,6,4]<>", <I>b</I>&nbsp;=&nbsp;"<>printF[b,6,4]<>" and <I>c</I>&nbsp;=&nbsp;"<>printF[mean,6,4]<>
"<BR>are chosen to make scaled coefficients of order of one in magnitude for all <I>n</I>."<>
"<BR>Coefficient <I>E</I><SUB>1</SUB>&nbsp;=&nbsp;"<>printF[func[[1]],4,2]<>" is not shown because it is too small and out of scale"<>
"</TH></TR>\n
<TR ALIGN=\"CENTER\" VALIGN=\"MIDDLE\"><TD>\n
<IMG SRC=\"" <> sect <> ".gif?"<>rndm<>"\" WIDTH=666 HEIGHT=412 ALT=\"Plot of MP coefficients\"></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.