Slope Field and Function Grapher

This tool allows you to enter a first-order differential equation and a function; the applet will plot the slope field of the differential equation together with the function.  Note that the differential equation should be for y in terms of t.

You must specify the minimum and maximum t values to plot; if you like, you may also enter the minimum and maximum y values.  

Note: If you need help figuring out how to enter functions in Mathematica, please see MouseOver.

Off[General::"spell1"];
DynamicModule[{graphs,f,x0,x1,y0,y1,plots,range,style,button,PlotPhasePortrait,PlotDirectionField,ticks},

ticks[xmin_,xmax_]:=
Module[{scale,numTicks,done},

(* provisionally say the distance between ticks is the biggest power of 10 that allows for ticks *)
scale=10^Floor[Log[10,xmax-xmin]];

(* adjust tick size if necessary *)
done=False;
While[!done,

(* in that case, we will have this many ticks *)
numTicks=Floor[xmax/scale]-Ceiling[xmin/scale];

(* if that's not enough, change the scale *)
If[numTicks<3,scale/=2,
(* if it's too many, change the scale *)
If[numTicks>9,scale*=2,

(* otherwise, it's just right! *)
done=True]];
];

(* make a list of ticks *)
Table[{k*scale,Style[k*scale,FontFamily->"Times"]},{k,Ceiling[xmin/scale],Floor[xmax/scale]}]
];

Options[PlotPhasePortrait] = {PlotColor -> RGBColor[0, 0, 0], PlotPoints ->13};

PlotPhasePortrait[{g_, h_}, {x_, x0_, x1_}, {y_, y0_, y1_}, opts___?OptionQ] :=Module[{width, height, fx, fy, sx, sy, snorm, scale, field, color, points, plotoptions, opt,s,t},

color = PlotColor /. {opts} /. Options[PlotPhasePortrait];points = (PlotPoints /. {opts} /. Options[PlotPhasePortrait])-1;
   
(* the rest of the options should be passed to Show *)
plotoptions = {};
Do[opt = {opts}[[n]];
If[(TrueQ[opt[[1]] == PlotColor]) || (TrueQ[opt[[1]] == PlotPoints]), ,
AppendTo[plotoptions, opt]], {n, 1, Length[{opts}]}];
 
(* the width and height of the plot *)
width = x1 - x0;
height = y1 - y0;
   
(* the length of each line *)
scale = 0.25 / (points + 1);
 
(* field stores the graphics primitives of the field *)
field = {color, PointSize[0.02]};
   
(* iterate over each point where we want to draw a slope *)
Off[Power::"infy"];
Off[∞::"indet"];

(* iterate over points where we want to draw slopes *)
Do[
(* evaluate g and h at the point *)
fx=g/.{x->s, y->t};
fy=h/.{x->s, y->t};
    
(* figure out how long these would be on the plot (plot will have aspect ratio 1) *)
sx = fx / width;
sy = fy / height;
snorm = Sqrt[sx^2 + sy^2];

(* if snorm is non-numeric, that means it's infinity or indeterminate, so we'll ignore it *)
If[NumericQ[snorm],
(* if the norm is 0, it's an equilibrium point; otherwise, rescale to have the right length *)
If[snorm == 0, AppendTo[field, Point[{s, t}]],
     
fx /= snorm;
fy /= snorm;

fx *= scale;
fy *= scale;
     
AppendTo[field, Line[{{s - fx, t - fy}, {s + fx, t + fy}}]]
]
],
{s, x0, x1, (x1 - x0)/points},
{t, y0, y1, (y1 - y0)/points}
];
   
On[Power::"infy"];
On[∞::"indet"];

field=Flatten[field];
Show[Graphics[{}],plotoptions,ImageSize->420,AspectRatio->1,Axes->True,PlotRange->{{x0,x1},{y0,y1}},AxesLabel->{Style[ToString[x],FontSlant->"Italic"],Style[ToString[y],FontSlant->"Italic"]},Ticks->ticks,Epilog->field]
];

PlotDirectionField[f_,{x_,x0_,x1_},{y_,y0_,y1_},opts___?OptionQ]:=
PlotPhasePortrait[{1,f},{x,x0,x1},{y,y0,y1},opts,PlotPoints->25,
PlotColor->{Black,Thickness[0.005]},AxesStyle->Directive[Thin,GrayLevel[0.7]]
];

Module[{errors,warnings},

(* defaults *)
graphs=Plot[1,{x,0,1},PlotRange->{0,0.1},Axes->False,ImageSize->420,AspectRatio->1,Background->White];
f={y,-2E^t};
x0=-4;x1=4;y0=-4;y1=4;

(* the button that does all the work *)
button=Button["Graph!",
(* first error check *)
errors={};

(* check plot range *)
If[!NumericQ[x0],AppendTo[errors,"Minimum x value must be a number"]];
If[!NumericQ[x1],AppendTo[errors,"Maximum x value must be a number"]];
If[!NumericQ[y0]&&ToString[y0]≠"Null",AppendTo[errors,"Invalid minimum y (you may leave this blank)"]];
If[!NumericQ[y1]&&ToString[y1]≠"Null",AppendTo[errors,"Invalid maximum y (you may leave this blank)"]];

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],

(* no errors, go! *)
plots={};
style={};

(* first see whether the functions seem valid; if not, just put up a warning dialog but don't fail *)
On[General::plnr];
Quiet[On[Plot::plnr]];
warnings={};

(* cheesy check -- replace t by y and graph, then vice versa *)
If[ToString[f[[1]]]≠"Null"&&
(TrueQ[Quiet[Check[Plot[f[[1]]/.{y->t},{t,x0,x1}],"Error"]]=="Error"]||
TrueQ[Quiet[Check[Plot[f[[1]]/.{t->y},{y,x0,x1}],"Error"]]=="Error"]),
AppendTo[warnings,f[[1]]]];

If[ToString[f[[2]]]≠"Null"&&
TrueQ[Quiet[Check[Plot[f[[2]],{t,x0,x1}],"Error"]]=="Error"],
AppendTo[warnings,f[[2]]]];
Off[General::plnr];
Off[Plot::plnr];

If[
(Length[StringPosition[ToString[f[[1]]],"|"]]>0)
||(Length[StringPosition[ToString[f[[2]]],"|"]]>0),
AppendTo[warnings,"To type the absolute value of something, use Abs[something]"]
];

If[Length[warnings]>0,
CreateDialog[Join[{"Warning: The following functions may be entered incorrectly."},warnings,{"Make sure you are using t as your independent variable"},{DefaultButton[]}],Modal->True]];

(* get the plot range by graphing everything together on one plot and using whatever range is automatically generated *)
range=AbsoluteOptions[Plot[f,{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];

(* finally, animate *)
graphs=Show[
PlotDirectionField[f[[1]],{t,x0,x1},{y,range[[1]],range[[2]]}],
Plot[f[[2]],{t,x0,x1},PlotRange->range,PlotStyle->Directive[Red,Thickness[0.004]]],
Background->White,ImageSize->420
];
]
];

Panel[
Grid[{{
(* top left of main grid *)
Grid[
{{"(dy/dt) = ",InputField[Dynamic[f[[1]]]]},
{"function ", InputField[Dynamic[f[[2]]]]},

{button,SpanFromLeft}
}],

(* top right of main grid *)
Grid[
{{"Minimum t",
InputField[Dynamic[x0],FieldSize->4]},
{"Maximum t",
InputField[Dynamic[x1],FieldSize->4]},
{"Minimum y",
InputField[Dynamic[y0],FieldSize->4]},
{"Maximum y",
InputField[Dynamic[y1],FieldSize->4]}
}
]
},
{},
(* bottom of main grid *)
{Dynamic[graphs],SpanFromLeft,SpanFromLeft,SpanFromLeft}},
Spacings->{2,1},Alignment->{Left,Baseline}
]
]
]
]