(*Location of singularities of diagonal quadratic and differential approximants*)
sect = "sings3";
entity = "figure";
boxed1[symb_] :=
"\!\(\* StyleBox[ FrameBox[StyleBox[\"" <> symb <>
"\", FontSize->16, FontWeight->\"Bold\", FontColor->GrayLevel[0]],
BoxMargins->{{0.2, 0.2}, {0.6, 0.6}}], FontSize->12,
FontWeight->\"Plain\", FontColor->GrayLevel[1],
Background->GrayLevel[1], FontVariations->{\"CompatibilityType\"->0}]\)";
boxed2[symb_] :=
"\!\(\* StyleBox[ FrameBox[StyleBox[\"" <> symb <>
"\", FontSize->16, FontWeight->\"Bold\", FontColor->RGBColor[0,0,0]],
BoxMargins->{{0.2, 0.2}, {0.6, 0.6}}], FontSize->12,
FontWeight->\"Plain\", FontColor->GrayLevel[0.7],
Background->GrayLevel[1], FontVariations->{\"CompatibilityType\"->0}]\)";
If[mindlist > 1, If[newfigure == True, Clear[pol, c, funs];
prec = 256;
setprec[z_] := SetPrecision[z, prec];
xyrange = 1.7/asave[name];
(*Presumed locations*)
Clear[s1, s2, s3, s4, s5, s6, s7, s8, s9];
s1 = -0.955 + 0.328 I;
s2 = 0.058 + 0.923 I;
s3 = 1.161 + 0.334 I;
s4 = -0.955 - 0.328 I;
s5 = 0.058 - 0.923 I;
s6 = 1.161 - 0.334 I;
slist = Select[{s1, s2, s3, s4, s5, s6, s7, s8, s9}, NumberQ];
mslist = Length[slist];
slist = {{Re[#], Im[#]}} & /@ slist;
scale = 2.8;
plts = If[mslist == 0, {},
MultipleListPlot[Sequence @@ slist,
SymbolShape -> shape[1],
SymbolStyle -> {{Thickness[0.003 scale], color[0]}},
PlotRange -> xyrange{{-1, 1}, {-1, 1}},
AspectRatio -> 1,
Frame -> True,
ImageSize -> 400,
DisplayFunction -> Identity]];
pltseq = {};
(*Cycle over indexes*)
Do[
{{n1, n2, n3}, prior, nc} = indlist[[nindlist]];
cf = func // setprec;
c[0] = 1;
pol[0] = Sum[c[n]z^n, {n, 0, n1}];
pol[1] = Sum[c[n + n1 + 1]z^n, {n, 0, n2}];
pol[2] = Sum[c[n + n1 + n2 + 2]z^n, {n, 0, n3}];
funs[z_] = Sum[cf[[n]]z^(n - 1), {n, nc}];
(*Quadratic approximant*)
pattern = pol[0] + pol[1]f[z] + pol[2]f[z]^2;
eqs = Take[CoefficientList[pattern /. f -> funs, z], nc];
s = Solve[eqs == Table[0, {nc}], Table[c[n], {n, nc}]];
ls = Length[s];
If[ls == 0, Print["No solutions of linear equations found!"]];
If[ls > 1, Print["More than one solution of linear equations!"]];
s1 = s[[1]];
{pa, pb, pc} = {pol[2], pol[1], pol[0]} /. s1;
pold = pb^2 - 4 pa pc;
sn = NSolve[pold == 0, z];
sn = Sort[sn, Abs[((z /. #1) - 0)] < Abs[((z /. #2) - 0)] &];
sings = z /. sn;
xylist = {Re[#], Im[#]} & /@ sings;
xylist =
Select[xylist, (Abs[#[[1]]] < 1.05 xyrange &&
Abs[#[[2]]] < 1.05 xyrange) &];
msing = Length[xylist];
scale = (10/(msing + 1))^0.3;
plt = MultipleListPlot[xylist,
SymbolShape -> shape[2],
SymbolStyle -> {{Thickness[0.008 scale], color[1]}},
TextStyle -> {FontFamily -> "Times New Roman", FontSize -> 12,
FontSubstitutions -> {"Math1" -> "Symbol"}},
PlotRange -> xyrange{{-1, 1}, {-1, 1}},
AspectRatio -> 1,
Frame -> True,
ImageSize -> 300,
DisplayFunction -> Identity];
label1 = Graphics[{Text[boxed1["Quadratic"], Scaled[{0.2, 0.95}]]}];
plt1 = Show[{plt, label1, plts},
Frame -> True,
DisplayFunction -> Identity];
(*Differential approximant*)
pattern = pol[0] + Sum[pol[k]D[f[z], {z, k - 1}], {k, 2}];
eqs = Take[CoefficientList[pattern /. f -> funs, z], nc];
s = Solve[eqs == Table[0, {nc}], Table[c[n], {n, nc}]];
ls = Length[s];
If[ls == 0, Print["No solutions of linear equations found!"]];
If[ls > 1, Print["More than one solution of linear equations!"]];
s1 = s[[1]];
nlast = 2;
pold = pol[2] /. s1;
sn = NSolve[pold == 0, z];
sn = Sort[sn, Abs[((z /. #1) - 0)] < Abs[((z /. #2) - 0)] &];
sings = z /. sn;
xylist = {Re[#], Im[#]} & /@ sings;
xylist =
Select[xylist, (Abs[#[[1]]] < 1.05 xyrange &&
Abs[#[[2]]] < 1.05 xyrange) &];
msing = Length[xylist];
scale = (15/(msing + 1))^0.3;
plt = MultipleListPlot[xylist,
SymbolShape -> shape[4],
SymbolStyle -> {{Thickness[0.008 scale], color[1]}},
TextStyle -> {FontFamily -> "Times New Roman", FontSize -> 12,
FontSubstitutions -> {"Math1" -> "Symbol"}},
PlotRange -> xyrange{{-1, 1}, {-1, 1}},
AspectRatio -> 1,
Frame -> True,
ImageSize -> 300,
DisplayFunction -> Identity];
label2 =
Graphics[{Text[boxed1["Differential"], Scaled[{0.2, 0.95}]]}];
plt2 =
Show[{plt, label2, plts}, Frame -> True,
DisplayFunction -> Identity];
(*Show together*)
wr = 0.1;
plt1r = Rectangle[{0, 0} // Scaled, {(1 - wr)/2, 1} // Scaled, plt1];
plt2r = Rectangle[{(1 - wr)/2, 0} // Scaled, {1 - wr, 1} // Scaled, plt2];
pltind = Table[{{n1, n2, n3}, prior, nc} = indlist[[n]];
txt =
If[nindlist <= mind,
"[" <> ToString[n1] <> ", " <> ToString[n2] <> ", " <>
ToString[n3] <> "]", ""];
t =
Text[txt, {1/2, 1/2},
TextStyle -> {FontFamily -> "Times New Roman", FontSize -> 14,
FontWeight -> If[n == nindlist, "Bold", "Plain"],
FontColor -> RGBColor[0, 0, 0.5]}];
col =
If[n > mind, RGBColor[1, 1, 1],
If[n == nindlist, RGBColor[1, 1, 0], RGBColor[3/4, 3/4, 3/4]]];
g = Graphics[t, Background -> col];
r =
Rectangle[{1 - wr, 0.062 + 0.938(mindlist - n)/mindlist} //
Scaled, {1, 0.062 + 0.938(mindlist - n + 1)/mindlist} // Scaled,
g];
r, {n, mindlist}];
plt = Show[{plt1r, plt2r, pltind} // Graphics, AspectRatio -> 0.41,
DisplayFunction -> Identity];
outfile = ToFileName[dir, sect <>ToString[nindlist] <> ".gif"];
Export[outfile, plt, "GIF", ImageSize -> 766, ImageResolution -> 72,
ConversionOptions -> {"AnimationDisplayTime" -> 1, "Loop" -> True,
"ColorReductionPalette" -> 16, "ColorReductionDither" -> False}];
pltseq = Append[pltseq, plt],
{nindlist, mindlist}];
outfile = ToFileName[dir, sect <> ".gif"];
Export[outfile, pltseq, "GIF", ImageSize -> 766, ImageResolution -> 72,
ConversionOptions -> {"AnimationDisplayTime" -> 1, "Loop" -> True,
"ColorReductionPalette" -> 16, "ColorReductionDither" -> False}];
];
"<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>
Location of singularities in the complex plane of the parameter <I>z</I>.
<BR>Left panel refers to quadratic approximants,
<BR>right panel to differential approximants.
<BR>To view an individual approximant, click on the right bar.
</TH></TR>" // p;
"<TR ALIGN=\"CENTER\" VALIGN=\"MIDDLE\"><TD>" <> "<IMG SRC=\"" <> sect <>
".gif?" <> rndm <>
"\" WIDTH=766 HEIGHT=314 BORDER=0 ALT=\"Location of singularities in the
complex plane\" USEMAP=\"#indbar\"></TD></TR>" <> "</TABLE></TD></TR></TABLE>
<MAP name=\"indbar\">" // p;
x0 = 687;
x1 = 764;
ytop = 0;
ybot = 294;
Do[y1 = ytop + n/mindlist (ybot-ytop);
y0 = ytop + (n-1)/mindlist (ybot-ytop);
{x0p, x1p, y0p, y1p} = ToString/@Round/@{x0, x1, y0, y1};
ref = sect <> ToString[n] <> ".gif?" <> rndm;
{{n1, n2, n3}, prior, nc} = indlist[[n]];
app = "[" <> ToString[n1] <> ", " <> ToString[n2] <> ", " <> ToString[n3] <> "]";
"<AREA shape=\"rect\" coords=\"" <> x0p <> ","<> y0p <> ","<> x1p <> ","<> y1p <>
"\" href=\"" <> ref <> "\" onclick=\"window.open('" <> ref <>
"','Singularities','toolbar=no,status=no,scrollbars=no,
location=no,menubar=no,directories=no,width=776,height=324'); return false\">" // p;
, {n, mind}];
"<AREA shape=\"default\" nohref></MAP>" // p;
printprogr[sect]; printnav,
"<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>
Singularities of approximants in the complex plane
<BR>are <FONT COLOR=\"#FF0000\">not shown</FONT> for this example (" <> name <>
")
<BR>because number of available coefficients of the series (" <>
ToString[nm] <> ")
<BR>is too small to construct a meaningful approximant
</TH></TR>
</TABLE></TD></TR></TABLE>" // p;
"<FONT SIze=\"-2\"><A HREF=\"#top\">
<IMG SRC=\"../../../../iconz/top.gif\" WIDTH=13 HEIGHT=9 BORDER=0
ALT=\"Top of Page\" ALIGN=\"MIDDLE\"></A>
<A HREF=\"#top\">Top of the page</A>
" // p;
If[nser != 1, namem = names[[nser - 1]];
nameml = StringReplace[ToLowerCase[namem], "+" -> "-"];
ref = "../" <> nameml <> "/index.htm#" <> sect;
" <A HREF=\"" <> ref <>
"\"><IMG SRC=\"../../../../iconz/top270.gif\" WIDTH=9 HEIGHT=13
BORDER=0 ALT=\"Previous Example\" ALIGN=\"MIDDLE\"></A>
<A HREF=\"" <> ref <> "\">Prev. (" <> namem <> ")</A>" // p];
" <IMG SRC=\"../../../../blank.gif\" WIDTH=13
HEIGHT=9 BORDER=0 ALT=\"Blank\" ALIGN=\"MIDDLE\"> Current (" <>
name <> ")" // p;
If[nser != mser, namep = names[[nser + 1]];
namepl = StringReplace[ToLowerCase[namep], "+" -> "-"];
ref = "../" <> namepl <> "/index.htm#" <> sect;
" <A HREF=\"" <> ref <>
"\"><IMG SRC=\"../../../../iconz/top90.gif\" WIDTH=9 HEIGHT=13
BORDER=0 ALT=\"Next Example\" ALIGN=\"MIDDLE\"></A> <A HREF=\"" <>
ref <> "\">Next (" <> namep <> ")</A>" // p];
" " // p;
" <A HREF=\"../" <> sect <>
".htm\"><IMG SRC=\"../../../../iconz/smalldig.gif\" WIDTH=12
HEIGHT=17 BORDER=0 ALT=\"Mathematica program\"
ALIGN=\"MIDDLE\"></A> <A HREF=\"../" <> sect <>
".htm\"><I>Mathematica</I> program</A>" // p;
"</FONT><BR><BR>" // p;]; |
