(* :Title: diffpack *) (* :Authors: Phillip Kent, Phil Ramsden, John Wood The METRIC Project, Imperial College, London. *) (* :Summary: This package contains functions used in the Differentiation learning modules written by the METRIC Project. The learning modules are published in the book "Experiments in Undergraduate Mathematics: A Mathematica-based approach" (Imperial College Press, 1996). *) (* :Package Version: 2.3 *) (* :Mathematica Version: 2.2 and 3.0 *) (* :Copyright: Copyright Imperial College 1994 - 1996 *) (* :History: Version 1 prepared March-May 1994; Version 1.1 Sept 1994 - some changes including end-of-module evaluation stuff; Version 1.1.1 Oct 94 - usage messages done by Phil Ramsden; Version 1.1.2 29 Oct 94 - correction to ImplicitPlot; Version 1.1.3 Feb 95 - new-style exercise codes; Version 2.0 - New Paradigm - September 1995; v2.0.1 (16/10/95): includes major improvements to PlotChord and additional material for the new Differentiation 2 module; v2.0.2 (18/10/95): added commands to the defaultLogCommandsList v2.0.3 (05/01/96): stuff for RunExperiment deleted - fixed a bug in "implicit functions" practice question; v2.0.4 (12/02/96) - new abort at start mechanism; v2.0.5 (21/10/96) - unused function ChordGradient deleted; Version 2.3 - for Mathematica 3.0 - NO CHANGES REQUIRED. *) (* Stop if pack already loaded - set diffLoadedQ = False to bypass this *) If[algLoadedQ, Print["diffpack already loaded. Set diffLoadedQ=False to reload."]; Abort[] ] (* Run Start-up code *) NotebookCode="DF" defaultLogCommandsList = {"GiveQuestion","LastAnswer","StraightLinesPicture", "PlotChord","tangentGradient","PlotWithSP","ImplicitPlot","ImplicitPictures"} <Automatic] (* Put up a diagram for Diff 2, Experiment 4 *) ImplicitPictures:= Show[ GraphicsArray[ {ImplicitPlot[x^2 + 4 y^2 == 4, {x, -3, 3}, {y, -2, 2}, DisplayFunction->Identity], ImplicitPlot[y^2 == x^2(3+x), {x, -4, 2}, {y, -3, 3}, DisplayFunction->Identity], ImplicitPlot[x^4 + y^4 == 16, {x, -3, 3}, {y, -3, 3}, DisplayFunction->Identity]} ], DisplayFunction->$DisplayFunction ] (* PlotChord *) Options[PlotChord] = {ShowTangent->False,PrintNumbers->True, PlotStyle->{RGBColor[1,0,0], RGBColor[0,0,1], RGBColor[0,0.5,0]}}; PlotChord[expr_,xRange_List,x0_,x1_,opts___] := Module[{showTangent,printNumbers,plotStyle,y0,y1}, ({showTangent,printNumbers,plotStyle}= {ShowTangent,PrintNumbers,PlotStyle}/.{opts}/.Options[PlotChord]; With[{var = First[xRange]}, y0 = expr/.var->x0; y1 = expr/.var->x1; If[printNumbers, (Print["Change in y = "<>ToString[N[y1-y0]]]; Print["Change in "<>ToString[var]<> " = "<>ToString[N[x1-x0]]]; Print["Gradient of chord = "<> ToString[N[(y1-y0)/(x1-x0)]]])]; Show[{Plot[Evaluate[Join[ {expr, -((var*y0 - x1*y0 - var*y1 + x0*y1)/(-x0 + x1))}, If[showTangent, {y0 + (Evaluate[D[expr, var]]/.var->x0)(var-x0)}, {}] ]],xRange,DisplayFunction->Identity, Evaluate[Sequence[Select[{opts},Not[MemberQ[ {ShowTangent,PrintNumbers},#[[1]]]]&]]], PlotStyle->{RGBColor[1,0,0], RGBColor[0,0,1], RGBColor[0,0.5,0.5]}], Graphics[{PointSize[0.02], Point[{x0,y0}], Point[{x1,y1}], Thickness[0.01], plotStyle[[2]], Line[{{x0,y0},{x1,y1}}]} ]}, DisplayFunction->$DisplayFunction]])] (* ImplicitPlot function *) Options[ImplicitPlot] = {AspectRatio->Automatic, Axes->True, Frame->False, AxesOrigin->{0,0}, PlotPoints->60}; ImplicitPlot[eqn_,xRange_List,yRange_List,opts___] := ContourPlot[Evaluate[Apply[Subtract,eqn]],xRange,yRange, ContourShading->False, Contours->{0}, opts, Evaluate[ Apply[Sequence,Options[ImplicitPlot]]]] (* PlotWithSP function *) ReQ[x_] := TrueQ[Im[x]==0] PlotWithSP[expr_,xRange_List,opts___] := ( Module[{spRules,spcoords}, With[{var = First[xRange]}, (spRules = Chop[NSolve[Evaluate[D[expr,var]]==0, var]]; spcoords = Transpose[{Select[var/.spRules,ReQ], Select[expr/.spRules,ReQ]}])]; With[{xLength = xRange[[3]] - xRange[[2]]}, Show[ {Plot[expr,xRange,DisplayFunction->Identity, opts, PlotStyle->RGBColor[1,0,0]], Graphics[ {RGBColor[0,0,1], Thickness[0.01], Thread[Line[ Map[{(# - {xLength/8,0}), (# + {xLength/8,0})}&,spcoords]]]}], Graphics[{PointSize[0.02],Map[Point,spcoords,1]}] },DisplayFunction->$DisplayFunction]]; spcoords] ) (* Functions called by Practice Questions *) (* type1fn - type4fn: called in Differentiation 2 "stationary points" and "max, min, etc" *) type1fn[x_,a_,b_] := Together[x+a^2/x+b] type2fn[x_,a_,b_] := Expand[3x^4 - 4 (a+b) x^3 + 6 a b x^2] type3fn[x_,a_,b_] := Expand[2x^3 - 3a x^2 + b] type4fn[x_,a_,b_] := (x + a b) (x - a b)/ (x (Expand[(a^2+b^2)x- 2 a^2 b^2])) (* sptype: called in Differentiation 2: "max, min, etc" *) sptype[1]="(minimum)"; sptype[-1]="(maximum)"; (********************************************************************************* ************************** Practice Question codes ****************************** ********************************************************************************* *) (* Differentiation 1: "diff, simple x^n" *) QuestionTemplate["diff, simple x^n"] = "What is the derivative of `1` with respect to `2`?"; AnswerTemplate["diff, simple x^n"] = "The derivative is `1`"; ParameterSets["diff, simple x^n"] = {{{x,y,t}}, {{2,3,4,5,6,7,8,9,10}} }; QuestionFunction["diff, simple x^n"]= { #1^#2, #1 }&; AnswerFunction["diff, simple x^n"]= { #2 * #1^(#2-1) }&; (* Differentiation 1: "diff, harder x^n" *) QuestionTemplate["diff, harder x^n"] = "What is the derivative of `1` with respect to `2`?"; AnswerTemplate["diff, harder x^n"] = "The derivative is `1`"; ParameterSets["diff, harder x^n"] = {{{x,y,t}}, {{-1,-2,-3,-4,-5,1/2,-1/2,3/2,-3/2,1/3,-1/3,2/3,-2/3}} }; QuestionFunction["diff, harder x^n"]= { #1^#2, #1 }&; AnswerFunction["diff, harder x^n"]= { #2 * #1^(#2-1) }&; (* Differentiation 1: "diff, several terms" *) QuestionTemplate["diff, several terms"] = "What is the derivative of `1` with respect to `2`?"; AnswerTemplate["diff, several terms"] = "The derivative is `1`"; ParameterSets["diff, several terms"] = {{{x,y,t}}, {{-5,-4,-3,-2,-1,1,2,3,4,5}}, {{-1,-2,-3,-4,-5,2,3,4,5}}, {{-5,-4,-3,-2,-1,1,2,3,4,5}}, {{1/2,-1/2,3/2,-3/2,1/3,-1/3,2/3,-2/3}}, {{-5,-4,-3,-2,-1, 0,1,2,3,4,5}, { 1, 1, 1, 1, 1,10,1,1,1,1,1}}, {{-1,-2,-3,-4,-5,2,3,4,5,1/2,-1/2,3/2,-3/2,1/3,-1/3,2/3,-2/3}} }; QuestionFunction["diff, several terms"]= { #2 * #1^#3+ #4 * #1^#5+#6 * #1^#7, #1 }&; AnswerFunction["diff, several terms"]= {D[#2 * #1^#3+ #4 * #1^#5+#6 * #1^#7, #1] }&; (* Differentiation 1: "diff, miscellaneous" *) QuestionTemplate["diff, miscellaneous"] = "What is the derivative of `1` with respect to `2`?"; AnswerTemplate["diff, miscellaneous"] = "The derivative is `1`"; ParameterSets["diff, miscellaneous"] = {{{x,y,t}}, {{-5,-4,-3,-2,-1,1,2,3,4,5}}, {{-1,-2,-3,-4,-5,2,3,4,5,1/2,-1/2,3/2,-3/2,1/3,-1/3,2/3,-2/3}}, {{-5,-4,-3,-2,-1,1,2,3,4,5}}, {{Exp,Sin,Cos,Log,ArcSin,ArcTan}}, {{-5,-4,-3,-2,-1, 0,1,2,3,4,5}, { 1, 1, 1, 1, 1,10,1,1,1,1,1}}, {{Exp,Sin,Cos,Log,ArcSin,ArcTan}} }; QuestionFunction["diff, miscellaneous"]= { #2 * #1^#3+ #4 * #5[#1]+#6 *#7[#1], #1 }&; AnswerFunction["diff, miscellaneous"]= {D[#2 * #1^#3+ #4 * #5[#1]+#6 *#7[#1], #1] }&; (* Differentiation 2: "product rule" *) QuestionTemplate["product rule"] = "What is the derivative of `2` with respect to `1`?"; AnswerTemplate["product rule"] = "The derivative is `1`"; ParameterSets["product rule"] = {{{x,y,t}}, {WithoutReplacement[ {Exp,Sin,Cos,Log,ArcSin,ArcTan,Sqrt,#^2&},2]} }; QuestionFunction["product rule"]= { #1, #2[#1] #3[#1] }&; AnswerFunction["product rule"]= { #2'[#1] #3[#1] + #2[#1] #3'[#1] }&; (* Differentiation 2: "quotient rule" *) QuestionTemplate["quotient rule"] = "What is the derivative of `2` with respect to `1`?"; AnswerTemplate["quotient rule"] = "The derivative is `1` \n \n \n \n `2``3``4`"; ParameterSets["quotient rule"] = {{{x,y,t}}, {WithoutReplacement[ {Exp,Log,ArcSin,ArcTan,Sqrt,#^2&},2]} }; QuestionFunction["quotient rule"]= { #1, #2[#1] /#3[#1] }&; AnswerFunction["quotient rule"]= Module[{dderiv,sderiv}, (dderiv=(#2'[#1] #3[#1] - #2[#1] #3'[#1])/(#3[#1]^2); sderiv=Simplify[dderiv]; { dderiv, If[ TrueQ[dderiv==sderiv], Unevaluated[Sequence["","",""]], Unevaluated[Sequence[ " (which simplifies to ", sderiv, ")." ]] ] })]&; (* Differentiation 2: "composite functions" *) QuestionTemplate["composite functions"] = "What is the derivative of `2` with respect to `1`?"; AnswerTemplate["composite functions"] = "The derivative is `1`"; ParameterSets["composite functions"] = {{{x,y,t}}, {WithoutReplacement[ {Exp,Sin,Cos,Sqrt,(1+#^2)&},2]} }; QuestionFunction["composite functions"]= { #1, #2[#3[#1]] }&; AnswerFunction["composite functions"]= { #3'[#1] #2'[#3[#1]] }&; (* Differentiation 2: "stationary points" *) QuestionTemplate["stationary points"] = "Find the coordinates of each of the stationary points of the curve y = `1`."; AnswerTemplate["stationary points"] = "`1`."; ParameterSets["stationary points"] = {{{type1fn,type2fn,type3fn,type4fn}}, {Integer,{-3,3}}, {WithoutReplacement[{1,2,3},2]}, {{Identity,Minus}}, {{Identity,Minus}} }; QuestionFunction["stationary points"]= { #1[x-#2,#5[#3],#6[#4]] }&; AnswerFunction["stationary points"]= With[{xlist= x/.Solve[D[#1[x-#2,#5[#3],#6[#4]],x]==0,x]}, ToString[ Transpose[ {xlist, Map[Function[{x},#1[x-#2,#5[#3],#6[#4]]],xlist] } ] ] ]&; (* Differentiation 2: "max, min, etc" *) QuestionTemplate["max, min, etc"] = "Locate and classify each of the stationary points of the curve y = `1`."; AnswerTemplate["max, min, etc"] = "`1`."; ParameterSets["max, min, etc"] = {{{type1fn,type2fn,type3fn,type4fn}}, {Integer,{-3,3}}, {WithoutReplacement[{1,2,3},2]}, {{Identity,Minus}}, {{Identity,Minus}} }; QuestionFunction["max, min, etc"]= { #1[x-#2,#5[#3],#6[#4]] }&; AnswerFunction["max, min, etc"]= Module[{xlist,ylist,mmlist,coords}, (xlist=x/.Solve[D[#1[x-#2,#5[#3],#6[#4]],x]==0,x]; ylist=Map[Function[{x},#1[x-#2,#5[#3],#6[#4]]],xlist]; mmlist= Map[ Function[{x}, Evaluate[ sptype[ Sign[D[#1[x-#2,#5[#3],#6[#4]],{x,2}]]]]],xlist]; coords=Transpose[{xlist,ylist}]; Show[ {Plot[#1[x-#2,#5[#3],#6[#4]], {x,Min[xlist]-2,Max[xlist]+2}, DisplayFunction->Identity], Graphics[{AbsolutePointSize[5],Map[Point,coords]}]}, DisplayFunction->$DisplayFunction]; ToString[Transpose[{coords,mmlist}]])]&; (* Differentiation 2: "implicit functions" *) QuestionTemplate["implicit functions"] = "For the implicit function `1`, express dy/dx in terms of x and y"; AnswerTemplate["implicit functions"] = "dy/dx = `1`"; ParameterSets["implicit functions"] = { {WithoutReplacement[ {(#3+#1^2)&, #2(#3-#2)&, #1(#3+ #2)&, (#1 + #3#2)&, Sin[#1 #2 #3]&,Cos[#3 #1 + #2]&},2]}, {WithoutReplacement[{-4,-3,-2,-1,1,2,3,4},2]} }; QuestionFunction["implicit functions"] = {#1[y,x,#3]==#2[y,x,#4]}&; AnswerFunction["implicit functions"] = (y'[x]/.Solve[D[#1[y[x],x,#3]==#2[y[x],x,#4],x],y'[x]])/. (y[x]->y)&; (* End of Practice Question codes *) (* Set Loaded flag *) diffLoadedQ = True; (* Everything OK---print message *) Print["Differentiation function package loaded. Please continue."]