# Location of singularities of diagonal quadratic and differential approximants

## Mathematica program

 ```(*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}]; ]; " sect <> "\">
" // p; "" // p; "" // p; "" <> "
Location of singularities in the complex plane of the parameter z.
Left panel refers to quadratic approximants,
right panel to differential approximants.
To view an individual approximant, click on the right bar.
" <> " sect <> ".gif?" <> rndm <> "\" WIDTH=766 HEIGHT=314 BORDER=0 ALT=\"Location of singularities in the complex plane\" USEMAP=\"#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] <> "]"; " 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}]; "" // p; printprogr[sect]; printnav, " sect <> "\">
" // p; "" // p; "
Singularities of approximants in the complex plane
are not shown for this example (" <> name <> ")
because number of available coefficients of the series (" <> ToString[nm] <> ")
is too small to construct a meaningful approximant
" // p; "    Top of the page     " // p; If[nser != 1, namem = names[[nser - 1]]; nameml = StringReplace[ToLowerCase[namem], "+" -> "-"]; ref = "../" <> nameml <> "/index.htm#" <> sect; "     ref <> "\">   ref <> "\">Prev. (" <> namem <> ")" // p]; "      Current (" <> name <> ")" // p; If[nser != mser, namep = names[[nser + 1]]; namepl = StringReplace[ToLowerCase[namep], "+" -> "-"]; ref = "../" <> namepl <> "/index.htm#" <> sect; "     ref <> "\">   ref <> "\">Next (" <> namep <> ")" // p]; "    " // p; "     sect <> ".htm\">   sect <> ".htm\">Mathematica program" // p; "

" // p;];```

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

Designed by A. Sergeev.