Taylor Polynomial Grapher

This tool allows you to enter a function, together with its general Taylor polynomial approximation, and see graphs of the function together with the Taylor polynomial approximations.

To use this, you will need to have your Taylor polynomial approximation in summation notation, as a sum from something to n.  

Example:
Let's say you want to compare cos(x) to its degree 15 and 25 Taylor polynomial approximations, which you know are written in summation notation as (∑_(k=0)^7)(((((-1))^k) (x^(2 k)))/((2 k)!)) and (∑_(k=0)^12)(((((-1))^k) (x^(2 k)))/((2 k)!)).  Then, the general form of the Taylor polynomial approximation is (∑_(k=0)^n)(((((-1))^k) (x^(2 k)))/((2 k)!)), and you are interested in n = 7,12.  So, for the function you want to graph, you enter Cos[x]; for the Taylor polynomial approximation expression, you enter (∑_(k=0)^n)(-1)^k*x^(2k)/(2k)!.  For the values of n you'd like to see, you choose "Use these specific n" and then enter 7,12.  Finally, you click the "Graph!" button.  When the graphs appear, click the triangular play button to see them all.  (There will be 2; one showing cos(x) with the degree 15 approximation and one showing cos(x) with the degree 25 approximation.  In each, the red graph is the function cos(x), and the blue graph is the Taylor polynomial approximation.)

DynamicModule[{graphs,f,g,n0,n1,x0,x1,y0,y1,nRange,nList,button,nograph},
Module[{plots,range,style,funcs,nToUse,n,progress,progressInt,run,dialog,errors,warnings,ft,gt},
SetOptions[$FrontEnd,DynamicEvaluationTimeout->600];
graphs=nograph=ListAnimate[{Plot[1,{x,0,1},PlotRange->{0,0.1},Axes->False,ImageSize->480]},AnimationRunning->False,AnimatorElements->{"ProgressSlider","ResetPlayButton"}];

Clear[x,k,t];
nRange=True;
nList=Null;
f=Cos[x];
g={0,(-1)^(k)*x^(2k)/(2k)!};
n0=1;
n1=5;
x0=-10;
x1=10;
y0=Null;
y1=Null;

(* the button that does all of the work *)
button=Button["Graph!",
(* first error check *)
errors={};
If[!IntegerQ[g[[1]]],AppendTo[errors,"  Lower bound of summation must be an integer."]];
If[ToString[f]=="Null",
AppendTo[errors,"  You must enter a function to graph."]];

If[ToString[g[[2]]]=="Null",
AppendTo[errors,"  You must enter something for your Taylor polynomial approximation"]];

If[nRange,
(* check min and max n *)
If[!IntegerQ[n0]||n0<g[[0]]||!IntegerQ[n0]||n1<g[[0]]||n0>n1,
AppendTo[errors,"  Invalid range of n values"]];

(* fine, here's the list of n to use *)
nToUse=Table[n,{n,n0,n1}],

(* using a specific list of n, check all *)
nToUse=ToExpression["{"<>nList<>"}"];
Do[n=nToUse[[i]];
If[!IntegerQ[n]||n<g[[0]],
AppendTo[errors,"   "<>ToString[n]<>" is not a valid value for n."]],
{i,1,Length[nToUse]}]
];
If[!NumericQ[x0],
AppendTo[errors,
"  The minimum x must be a number."]];
If[!NumericQ[x1],
AppendTo[errors,
"  The maximum x must be a number."]];
If[NumericQ[x0]&&NumericQ[x1]&&x0≥x1,
AppendTo[errors,  "The minimum x must be less than the maximum x."]];
If[NumericQ[y0]&&NumericQ[y1]&&y0≥y1,
AppendTo[errors,  "The minimum y must be less than the maximum y."]];

If[Length[errors]==0,
If[
Quiet[Check[Plot[Sum[(g/.x->t)[[2]],{k,g[[1]],Max[nToUse]}],{t,x0,x1}],"divideby0",{Power::"infy"}]=="divideby0"],
AppendTo[errors,"    Invalid Taylor polynomial expression: you are dividing by 0 somewhere"]]
];

If[Length[errors]>0,
(* if there are errors, pop up a dialog box and don't
 do anything else *)
CreateDialog[Join[{"Error:"},errors,{DefaultButton[]}],Modal->True],

(* otherwise, go! *)
progress=0;
run=True;

(* plot in terms of t instead of x, so the input fields don't
 try to update *)
ft=f/.x->t;
gt=g/.x->t;

(* check to see whether function and Taylor polynomial approx appear to be valid *)
On[Plot::plnr];
On[General::plnr];
warnings={};
If[TrueQ[Quiet[Check[Plot[ft,{t,x0,x1}],"Error"]]=="Error"],
AppendTo[warnings,f]];
If[TrueQ[Quiet[Check[Plot[Sum[gt[[2]],{k,g[[1]],Max[nToUse]}],{t,x0,x1}],"Error"]]=="Error"],
AppendTo[warnings,g[[2]]]];
Off[Plot::plnr];
Off[General::plnr];

If[Length[warnings]>0,CreateDialog[Join[{"Warning: The following expressions appear to be entered incorrectly."},warnings,{DefaultButton[]}],Modal->True]];

(* pop up a dialog box to show progress *)
dialog=CreateDialog[{"Generating graphs...",ProgressIndicator[Dynamic[Refresh[progress,UpdateInterval->1]]],
Button["Stop",run=False;DialogReturn[],Method->"Preemptive"]}];

(* get the plot range by graphing everything together on one plot and using whatever range is automatically generated *)
range=AbsoluteOptions[Plot[ft,{t,x0,x1},DisplayFunction->Identity],PlotRange][[1]][[2]][[2]];

(* if the user specified y range, use those *)
If[NumericQ[y0],range[[1]]=y0];
If[NumericQ[y1],range[[2]]=y1];

(* now graph *)
plots={};
progressInt=1/Length[nToUse];

Do[If[run,
n=nToUse[[i]];progress+=progressInt;
AppendTo[plots,
Column[{
"n="<>ToString[n],
Plot[{ft,
Sum[gt[[2]],{k,g[[1]],n}]
},
{t,x0,x1},PlotRange->1.1*range,DisplayFunction->Identity,WorkingPrecision->30,PlotStyle->{{Hue[0],Thickness[0.003]},{Hue[2/3],Thickness[0.003]}},ImageSize->480]
}]]],
{i,1,Length[nToUse]}];

(* finally, animate *)
If[progress==1,
graphs=ListAnimate[plots,1,AnimationRepetitions->1,DefaultDuration->Length[nToUse],AnimatorElements->{"ProgressSlider","ResetPlayButton"},Deployed->True,DisplayAllSteps->True,AnimationRunning->False],
graphs=nograph];

(* make the dialog box go away *)
NotebookClose[dialog]

(* end of button action *)
],
Method->"Queued"];

(* the display *)
Panel[
Grid[
{{Style["-",Hue[0],Background->RGBColor[1,1,1],FontSize->24,FontWeight->Bold],
Row[{"Enter the function you want to graph: ",InputField[Dynamic[f]]}]},
{Style["-",Hue[2/3],Background->RGBColor[1,1,1],FontSize->24,FontWeight->Bold],
Row[{"Enter the expression for the Taylor polynomial approximations: "
Grid[
{{Style["n",Small],SpanFromLeft,"",""},{Style["Σ",FontSize->48],SpanFromLeft,InputField[Dynamic[g[[2]],TrackedSymbols->{}],FieldSize->10]},{Style["k =",Small],InputField[Dynamic[g[[1]]],Number,FieldSize->2,BaseStyle->Small]}},
Alignment->{Center,Center}]}]},
{"Enter the values of n you'd like to see",SpanFromLeft},{RadioButton[Dynamic[nRange,TrackedSymbols->{nRange}],True],Row[{"Use all n between ",
InputField[Dynamic[n0,TrackedSymbols->{}],Number,FieldSize->4]," and ",
InputField[Dynamic[n1,TrackedSymbols->{}],Number,FieldSize->4]}]},
{RadioButton[Dynamic[nRange,TrackedSymbols->{nRange}],False],Row[{"Use these specific n (enter a list, separated by commas): ",InputField[Dynamic[nList,TrackedSymbols->{}],String]}]},
{"Choose the region to plot (y values are optional)",SpanFromLeft},
{Grid[
{{"Minimum x",
InputField[Dynamic[x0,TrackedSymbols->{}],Expression,FieldSize->4],"Maximum x",
InputField[Dynamic[x1,TrackedSymbols->{}],Expression,FieldSize->4],"Minimum y",
InputField[Dynamic[y0,TrackedSymbols->{}],Expression,FieldSize->4],"Maximum y",
InputField[Dynamic[y1,TrackedSymbols->{}],Expression,FieldSize->4]}},Spacings->{{3,1,3,1,3,1,3,1},0}],SpanFromLeft},
{Row[{button," ",Button["Clear Settings",f=Null;x0=Null;x1=Null;y0=Null;y1=Null;nRange=True;nList=Null;n0=Null;n1=Null;g={Null,Null}]}],SpanFromLeft},
{},
{"After you hit the \"Graph!\" button, the graphs will appear below.",SpanFromLeft},
{"Click the triangular play button to see all of the graphs.",SpanFromLeft},
{Dynamic[graphs],SpanFromLeft}},
Dividers->{False,{2->GrayLevel[0.5],3->GrayLevel[0.5],6->GrayLevel[0.5],8->GrayLevel[0.5]}},Alignment->Left,Spacings->{0,1}
]

(* bottom of main grid 
{Dynamic[graphs],SpanFromLeft,SpanFromLeft,SpanFromLeft}},
Spacings->{2,3}*)
]
]
]