Graphics Settings

<< Miscellaneous`Units`;
Remove[Gray];
<< Graphics`Master`;
Off[General::spell1];
fs = 7;
fsbig = 9;
width  =  Convert[8.64 Centi Meter,  Point]/Point;
th  =  0.0008;

Figure 5.1

rr =  .03;
data = 
        Table[N[{t, z = (E^(I t)); 
              (1/Gamma)[z]}], {t, 1 °, 360 °, 
            1 °}];
fit = 
        Chop[Fit[
            data, {1, (E^(I x)), (E^(I 2 x)), (E^(I 3 x))}, x]];
data1 = 
        Table[N[{t, fit}], {x, 1 °, 360 °, 
            1 °}];
Show[Graphics[{{Dashing[{0.0001, 0.01}], Circle[{0, 0}, 1]},{Thickness[0.01], 
                  Line[data11 = ({Re[#1[[-1]]], 
                              Im[#1[[-1]]]} &) /@ data]},{Thickness[0.00001], 
                  Line[data12 = ({Re[#1[[-1]]], 
                              Im[#1[[-1]]]} &) /@ data1]},{Thickness[0.00001], 
                  Line /@ Transpose[{data11, data12}]},{{GrayLevel[ .95], Disk[{0, 0}, rr]}, 
                  Thickness[0.0001], Circle[{0, 0}, rr]},{{GrayLevel[ .95], Disk[{1, 0}, rr]}, 
                  Thickness[0.0001], Circle[{1, 0}, rr]},Text["f(z)",{-1.5, 1.45},TextStyle -> {FontFamily -> Times, 
                        FontSize -> fsbig + 1}],Text["(Subscript[(p), 0])(z)",{- .65, 1.45},TextStyle -> {FontFamily -> Times, 
                        FontSize -> fsbig + 1}],
Text["0", {- .15, 0}, 
                  TextStyle -> {FontFamily -> Times, 
                      FontSize -> fsbig + 1}],
Text["1", {1.15, 0}, 
                  TextStyle -> {FontFamily -> Times, 
                      FontSize -> fsbig + 1}]}],AspectRatio -> Automatic,FrameTicks -> {{-1, 0, 1}, {-1, 0, 
                1}, {}, {}},ImageSize -> width];

Figure 5.2

\(\(\( (*\ by\ Peter\ Gaffney\ and\ Stan\ Wagon; \ 
      for\ Mathematica\ 5.0\ *) \)\(
\)\(\(Off[
        FindMaximum::fmmp];\)


    \(maxerror[{a_?NumericQ, b_, c_, d_}, \ prec_] := 
        Max[Abs[a - b + c - 
              d], \(\(FindMaximum[
                  t = E\^\(I\ θ\); 
                  Abs[a\ t\^3 + b\ t\^2 + c\ t + d - 
                      1/Gamma[t]], {θ, # - 0.03, # + 0.03}, 
                  PrecisionGoal -> prec, 
                  AccuracyGoal -> ∞]\)[[1]] &\) /@ {1.40, 
              2.26}];\)


    \(Options[DifferentialEvolution]\  := \ {MaxIterations -> \ 300, \ 
          AmplificationFactor\  -> \ 0.4, \ AccuracyGoal -> 14, \ 
          Trace -> False, \ TraceStep -> 10, \ 
          StoppingGenerationsNumber -> 
            10};\)


    \(DifferentialEvolution[NP_, \ seeds_, \ opts___Rule] := 
        Module[{newbest, current, children, 
values, 
            childvalue, \ f, \ nmax, \ ag, \ trQ, \ 
            step}, 
{f, \ nmax, ag, \ trQ, step, 
              sgn}\  = \ \({AmplificationFactor, MaxIterations, \ 
                  AccuracyGoal, \ Trace, \ TraceStep, \ 
                  StoppingGenerationsNumber}\  /. {opts}\) /. 
              Options[DifferentialEvolution]; 
If[trQ, \ 
            data = {}]; 
current = 
            Table[\(Random[Real, #] &\)\  /@ \ 
                seeds, \ {NP}]; 
values = \(maxerror[#, 
                  2] &\)\  /@ \ current; 
oldbest\  = \ 
            Min[values]; 
Do[
If[
              trQ\  && Mod[i, step] == 0, 
              Print[StringForm[
"Generation ``, ``", \ 
                  ToString[i], 
                  NumberForm[Min[values], 
                    15]]]]; 
children\  = \ 
              Table[\ {1, 
                    f, \(-f\)} . 
current[\([Table[
                        Random[Integer, {1, NP}], {3}]]\)]\ , \ {j, \ 
                  NP}]; 
Do[
              If[\((childvalue = 
                      maxerror[children[\([j]\)], Ceiling[i/\((20)\)]])\) < 
                  values[\([j]\)], {current[\([j]\)], 
                    values[\([j]\)]} = {children[\([j]\)], childvalue}], {j, 
                NP}]; 
If[trQ, \ 
              AppendTo[data, 
                First[Sort[
                    Transpose[{values, \ current}]]]]]; 
If[
              Mod[i, sgn] == 0, 
              newbest = Min[values]; 
If[
                Abs[newbest - oldbest] < 10^\(-ag\), 
If[
                  trQ, Print[
                    StringForm[
"Generation ``, ``", \ 
                      ToString[i], 
                      NumberForm[Min[values], 15]]]]; 
\ 
                Break[], \ oldbest = newbest]], \ \ {i, 
              nmax}]; 
First[
            Sort[Transpose[{values, \ current}]]]];\)\)\)\)

SeedRandom[1];
DifferentialEvolution[60,  Table[{-2, 2},  {4}], 
        AccuracyGoal -> 14,  Trace -> True] // Timing

bestvals={-0.603343220479925996,0.6252119162842364,1.01976185283468839,0.00554195066098559};
best = 0.214335234590459639;

tv = 
        Range[1,  Length[data]];
{dataa, datab, 
          datac, datad} = 
        Table[Transpose[{tv,  #[[2, i]] &  /@  data}],  {i, 
            4}];
datacubic  =  
        Transpose[{tv, 
            First  /@  Rest  /@  
                data}];
dataans = 
        Transpose[{tv,  
            First  /@  data}];
datavec  =  
        Transpose[{tv, 
            Last  /@  data  /.  
              x_?VectorQ  :>  
                Log[10,  Norm[x - bestvals]]}];

DisplayTogether[
        ListPlot[
          d1 = dataans /. {t_,  vv_ } :>  {t,  
                  Log[10,  Norm[vv - best]]},  PlotJoined -> True,  
          PlotStyle -> Thickness[th]], 
ListPlot[
          datavec,  PlotJoined -> True,  
          PlotStyle -> Thickness[th]], 
 
        AxesOrigin -> {0, -17}, 
 
        PlotRange -> {{0, 200}, {-17,  .5}},  
        AxesLabel -> {DisplayForm@
              StyleBox["Generation",  
                FontFamily  ->  "Times",  
                FontSize -> fsbig], 
            DisplayForm@
              StyleBox["Error",  FontFamily  ->  "Times", 
                FontSize -> fsbig]},  
        TextStyle -> {FontFamily  ->  Times,  
            FontSize -> fs}, 
        Ticks -> {Range[50, 200,  
              50], { #, DisplayForm@SuperscriptBox[10, #]} &  /@  
              Range[-1, -17, -5]},  AspectRatio ->  .5, 
        ImageSize -> width 1.15];

Figure 5.3

Clear[f];
f[z_]  :=  1/Gamma[z];
p2[z_]  :=  -0.596767 (z^3) + 0.636408 (z^2) +  
        1.028102 z
\(\(DisplayTogether[
Plot[\((z\  = \ 
              E^\((I\ θ)\); Re[f[z]\  - \ p2[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> {Thickness[ .006], 
              Dashing[{ .009}]}], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); Im[f[z]\  - \ p2[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> {Thickness[th], 
              Dashing[{ .01}]}], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); Abs[f[z]\  - \ p2[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> 
            Thickness[th]], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); \(-Abs[
                f[z]\  - \ p2[z]]\))\), \ {θ, 0, 2  π}, \ 
          PlotStyle -> Thickness[th]], \ Frame -> True, \ 
        FrameTicks\  -> \ {Range[0, \ 2  π, \ π/2], 
            1.  Range[\(-1\)/4, \ 1/4, \ 
                1/20]; \ {0, \  .1, \  .25, \ \(- .1\), \ \(- .25\)}, {}, {}}, \ PlotRange -> {{0, \ 2  π}, {\(- .25001\), \  .25001}}, \ 
        TextStyle -> {FontFamily -> "Times", FontSize -> fs}, 
        ImageSize -> width];\)\)

Figure 5.4

Clear[f];
f[z_]  :=  1/Gamma[z];
p3[z_]  :=  -0.596767 (z^3) + 0.636408 (z^2) +  
          1.028102 z +  .014142;
\(\(DisplayTogether[
Plot[\((z\  = \ 
              E^\((I\ θ)\); Re[f[z]\  - \ p3[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> {Thickness[ .006], 
              Dashing[{ .009}]}], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); Im[f[z]\  - \ p3[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> {Thickness[th], 
              Dashing[{ .01}]}], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); Abs[f[z]\  - \ p3[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> 
            Thickness[th]], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); \(-Abs[
                f[z]\  - \ p3[z]]\))\), \ {θ, 0, 2  π}, 
          PlotStyle -> Thickness[th]], \ Frame -> True, \ 
        FrameTicks\  -> \ {Range[0, \ 2  π, \ π/2], 
            1.  Range[\(-1\)/4, \ 1/4, \ 
                1/20]; \ {0, \  .1, \  .25, \ \(- .1\), \ \(- .25\)}, {}, {}}, \ PlotRange -> {{0, \ 2  π}, {\(- .25001\), \  .25001}}, \ 
        TextStyle -> {FontFamily -> "Times", FontSize -> fs}, 
        ImageSize -> width];\)\)

Figure 5.5

Clear[f];
f[z_]  :=  1/Gamma[z];
p4[z_]  :=  -0.603343220407797 (z^3) + 
          0.625211916433389 (z^2) +  
          1.01976185298384 z +  .00554195073311;
\(\(DisplayTogether[
Plot[\((z\  = \ 
              E^\((I\ θ)\); Re[f[z]\  - \ p4[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> {Thickness[ .006], 
              Dashing[{ .009}]}], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); Im[f[z]\  - \ p4[z]])\), \ {θ, 0, 
            2  π}, \ 
          PlotStyle -> {Thickness[th], 
              Dashing[{ .01}]}], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); Abs[f[z]\  - \ p4[z]])\), \ {θ, 0, 
            2  π}, 
          PlotStyle -> 
            Thickness[th]], 
Plot[\((z\  = \ 
              E^\((I\ θ)\); \(-Abs[
                f[z]\  - \ p4[z]]\))\), \ {θ, 0, 2  π}, 
          PlotStyle -> Thickness[th]], \ Frame -> True, \ 
        FrameTicks\  -> \ {Range[0, \ 2  π, \ π/2], 
            1.  Range[\(-1\)/4, \ 1/4, \ 
                1/20]; \ {0, \  .1, \  .25, \ \(- .1\), \ \(- .25\)}, {}, {}}, \ PlotRange -> {{0, \ 2  π}, {\(- .25001\), \  .25001}}, \ 
        TextStyle -> {FontFamily -> "Times", FontSize -> fs}, 
        ImageSize -> width];\)\)