(* :Title: algpack *)

(* :Authors: Phillip Kent, Phil Ramsden, John Wood 
             Transitional Mathematics Project,
             Imperial College, London.
*)

(* :Summary: 
   This package contains functions used in the 
   Algebra learning modules written by T.M.P.
*)

(* :Package Version: 2.0.2 *)

(* :Mathematica Version: 2.2 *)

(* :Copyright: Copyright Imperial College 1995 *)

(* :History:
   Version 2.0, September 1995, is the first release version of
     this package (all packages at this date have been set at v2.0);
    v2.0.1 (18/10/95) - added commands to the defaultLogCommandsList;
    v2.0.2 (12/02/96) - new abort at start mechanism.
*)


(* Stop if pack already loaded - set algLoadedQ = False to bypass this *)

  If[algLoadedQ, 
    Print["algpack already loaded. Set algLoadedQ=False to reload."]; 
    Abort[] 
  ] 


(* Run Start-up code *)
  NotebookCode="AL"
  defaultLogCommandsList = {"GiveQuestion","LastAnswer","Exp","Prog","DoToBothSides",
      "SplitEquation"}
  <<Mathetic`StartUp` 

(* Load Practice Question code *)
  <<Mathetic`Question`


(******* Special functions accessible to the user *******)

(* CompleteSquare *)

CompleteSquare[a_.x_^2+b_. x_+ c_.] :=
  a((x+b/(2a))^2 - (b^2-4 a c)/(4a^2))
  
CompleteSquare[a_. x_^2+ c_.] :=
  a(x^2+c/a)
  
CompleteSquare[expr_] :=
  If[TrueQ[expr == Expand[expr]], expr,
  CompleteSquare[Expand[expr]]]
  
CompleteSquare::usage = 
"CompleteSquare[expr] returns expr with the square completed
if expr is quadratic, and expr unchanged otherwise.";

(* NewEquation *)
NewEquation[f_,eqn1_Equal,eqn2_Equal] :=
  Inner[f,eqn1,eqn2,Equal]
  
NewEquation[arg1_,arg2_,arg3_,args__]:=
  $Failed/;
   Message[NewEquation::argx,Length[{arg1,arg2,arg3,args}]]
   
NewEquation[arg_]:=
  $Failed/;
   Message[NewEquation::arg1]
   
NewEquation[arg1_,arg2_]:=
  $Failed/;
   Message[NewEquation::argx,2]
   
NewEquation[]:=
  $Failed/;
   Message[NewEquation::argx,0]
   
NewEquation[f_,num_,eqn_Equal]:=
  $Failed/;
   Message[NewEquation::noteqn1,num]
   
NewEquation[f_,eqn_Equal,num_]:=
  $Failed/;
   Message[NewEquation::noteqn1,num]
   
NewEquation[f_,num1_,num2_]:=
  $Failed/;
   (Head[num1]=!=Equal&&
   Head[num2]=!=Equal&&
   Message[NewEquation::noteqn2,num1,num2])
   
NewEquation::argx=
"NewEquation called with `1` arguments;  3 expected.";

NewEquation::arg1=
"NewEquation called with 1 argument; 3 expected.";

NewEquation::noteqn1 =
"The expression `` is not an equation.";

NewEquation::noteqn2 =
"Neither `` nor `` is an equation.";

NewEquation::usage = 
"NewEquation[f, expr1 == expr2, expr3 == expr4] returns the
equation f[expr1, expr2] == f[expr3, expr4].";

(* DoToBothSides *)

DoToBothSides[f_,eqn_Equal,num_] :=
  Map[f[#,num]&,eqn]
  
DoToBothSides[f_,num_,eqn_Equal] :=
  Map[f[num,#]&,eqn]
  
DoToBothSides[f_,eqn_Equal] :=
  Map[f,eqn]
  
DoToBothSides[arg1_,arg2_,arg3_,args__]:=
  $Failed/;
   Message[DoToBothSides::argx,Length[{arg1,arg2,arg3,args}]]
   
DoToBothSides[arg_]:=
  $Failed/;
   Message[DoToBothSides::arg1]
   
DoToBothSides[]:=
  $Failed/;
   Message[DoToBothSides::argx,0]
   
DoToBothSides[f_,num_]:=
  $Failed/;
   Message[DoToBothSides::noteqn1,num]
   
DoToBothSides[f_,num1_,num2_]:=
  $Failed/;
   Message[DoToBothSides::noteqn2,num1,num2]
   
DoToBothSides::argx=
"DoToBothSides called with `1` arguments; either 2 or 3
is expected.";

DoToBothSides::arg1=
"DoToBothSides called with 1 argument; either 2 or 3
is expected.";

DoToBothSides::noteqn1 =
"The expression `` is not an equation.";

DoToBothSides::noteqn2 =
"Neither `` nor `` is an equation.";

DoToBothSides::usage =
"DoToBothSides[f, expr1 == expr2] returns the equation
f[expr1] == f[expr2].\n\nDoToBothSides[f, expr1 == expr2, expr]
returns the equation f[expr1, expr] ==
f[expr2, expr].\n\nDoToBothSides[f, expr, expr1 == expr2]
returns the equation f[expr, expr1] == f[expr, expr2].";

(* SplitEquation *)

SplitEquation[c_. (a_)^2==b_] := 
{Sqrt[c] a==Sqrt[b],Sqrt[c]a==-Sqrt[b]}/.SqrtSimpRule

SplitEquation[b_==c_.(a_)^2] :=
{Sqrt[b]==Sqrt[c] a,-Sqrt[b]==Sqrt[c] a}/.SqrtSimpRule

SplitEquation[eqn_Equal] := 
  (Message[SplitEquation::wrongform,eqn];eqn)
  
SplitEquation[expr_] := 
  (Message[SplitEquation::noteqn,expr];expr)
  
SplitEquation::wrongform = 
"The equation `1` is not of the form a b^2 == c or c == a b^2.";

SplitEquation::noteqn = 
"The expression `1` is not an equation.";

SqrtSimpRule=(Sqrt[y_. Power[x_,n_]]->Sqrt[y] Power[x,n/2]);

SplitEquation::usage = 
"SplitEquation[a x^2 == b] returns the list
{Sqrt[a] x == Sqrt[b], Sqrt[a] x == - Sqrt[b]}.";
  

(*********************************************************************************
 ************************** Practice Question codes ******************************
 *********************************************************************************
*)

(* Utility functions for Practice Questions *)

PlusMinus[x_] := 
 Which[x<0," - ",
       x>0," + ",
       True,""]

ConditionalDrop10[x_] := If[x==1||x==0,"",ToString[x]<>" "]

ConditionalDrop0[x_] := If[x==0,"",x]

ConditionalDrop0[x_,y_] := If[x==0,"",y]

QuadraticInsertions[a_,b_,c_,x_] :=
  {ConditionalDrop10[a],
   x^2,
   PlusMinus[b],
   ConditionalDrop10[Abs[b]],
   ConditionalDrop0[b, x],
   PlusMinus[c],
   ConditionalDrop0[Abs[c]]}

QuadraticInsertions::usage = 
"QuadraticInsertions[a, b, c, x] generates a string consisting of the textual elements
of the expression a x^2 + b x + c, in descending order of
indices.";


(* Algebra 1: "simple expansion" *)

QuestionTemplate["simple expansion"] =  
 "Expand the expression   `1`";

AnswerTemplate["simple expansion"] =  
 "The expanded expression is   `1`";

ParameterSets["simple expansion"] = 
  {{{2,3,4,5,6,7,a,b},{1,1,1,1,1,1,3,3}},
   {{x,y}},
   {{-4,-3,-2,-1,1,2,3,4}}
  };

QuestionFunction["simple expansion"]=
  {#1 (#2+#3)}&;

AnswerFunction["simple expansion"]=
  {Expand[#1 (#2+#3)]}&;


(* Algebra 1: "expand and simplify" *)

QuestionTemplate["expand and simplify"] =  
 "Expand the expression   `1`    and simplify fully.";

AnswerTemplate["expand and simplify"] =  
 "The expanded and simplified expression is   `1`";

ParameterSets["expand and simplify"] = 
  {{Integer,{2,5}},
   {Integer,{2,5}},
   {{x,y,z,p,q,r}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {{a,b,c,1},
    {1,1,1,3}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {{-5,-4,-3,-2,-1, 0,1,2,3,4,5},
    { 1, 1, 1, 1, 1,15,1,1,1,1,1}}
  };

QuestionFunction["expand and simplify"]=
  {#1(#2 #3+#4 #5)+
   #6 #3+#7 #5}&;

AnswerFunction["expand and simplify"]=
  {Expand[#1(#2 #3+#4 #5)+
   #6 #3+#7 #5]}&;


(* Algebra 1: "expand two brackets" *)

QuestionTemplate["expand two brackets"] =  
 "Expand the expression   `1`";

AnswerTemplate["expand two brackets"] =  
 "The expanded expression is   `1`";

ParameterSets["expand two brackets"] = 
  {{{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {{-5,-4,-3,-2,2,3,4,5}},
   {{-5,-3,-2,-1, 0,1,2,3,5},
    { 1, 1, 1, 1, 5,1,1,1,1}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {{-5,-3,-2,-1, 0,1,2,3,5},
    { 1, 1, 1, 1,20,1,1,1,1}},
   {{x,y,z}},
   {{2,3,a,b,c}},
   {{p,q,r}},
   {{2,3,f,g,h},
    {3,3,3,1,1}}
  };

QuestionFunction["expand two brackets"]=
  { (#1 #7+#2 #8+#3) *
    (#4 #9+#5 #10+#6) }&;

AnswerFunction["expand two brackets"]=
  {Expand[(#1 #7+#2 #8+#3) *
    (#4 #9+#5 #10+#6)]}&;


(* Algebra 1: "simple factorisation" *)

QuestionTemplate["simple factorisation"] =  
 "Factorise the expression   `1`";

AnswerTemplate["simple factorisation"] =  
 "The factorised expression is   `1`";

ParameterSets["simple factorisation"] = 
  {{{2,3,4,5,6,7}},
   {{a,b,1},
    {1,1,4}},
   {{x,y}},
   {{1,2,3,4,a,b}},
   {{-4,-3,-2,-1,1,2,3,4,z}},
   {{-5,0,5,z},
    { 1,6,1,2}}
  };

QuestionFunction["simple factorisation"]=
  {Expand[#1 #2 (#3 #4 + #5 +#6)]}&;

AnswerFunction["simple factorisation"]=
  {Factor[Expand[#1 #2 (#3 #4 + #5 + #6)]]}&;


(* Algebra 1: "factorisation: two brackets" *)

QuestionTemplate["factorisation: two brackets" ] =  
 " Factorise the expression   `1`" ;

AnswerTemplate["factorisation: two brackets"] =  
 "The factorised expression is   `1`";

ParameterSets["factorisation: two brackets"] = 
  {{{1,2,4}},
   {{a,c}},
   {{-3,-1,1,3}},
   {{b,1}},
   {{1,2,4},
    {8,4,1}},
   {{x,z}},
   {{-3,-1,1,3},
    { 1,4,4,1}},
   {{y,1}}
  };


QuestionFunction["factorisation: two brackets"]=
  {Expand[(#1 #2 + #3 #4) (#5 #6 + #7 #8)]}&;

AnswerFunction["factorisation: two brackets"]=
  {Factor[Expand[(#1 #2 + #3 #4) (#5 #6 + #7 #8)]]}&;


(* Algebra 1: "factorisation: combined" *)

QuestionTemplate["factorisation: combined"] =  
 "Factorise the expression   `1`";

AnswerTemplate["factorisation: combined"] =  
 "The factorised expression is   `1`";

ParameterSets["factorisation: combined"] = 
  {{{1,2,4}},
   {{a,c}},
   {{-3,-1,1,3}},
   {{b,1}},
   {{1,2,4},
    {8,4,1}},
   {{x,z}},
   {{-3,-1,1,3},
    { 1,4,4,1}},
   {{y,1}},
   {{1,2,3}},
   {{a,b,c,x,y,z,1},
    {1,1,1,1,1,1,6}},
   {{a,b,c,x,y,z,1},
    {1,1,1,1,1,1,6}}
  };

QuestionFunction["factorisation: combined"]=
  {Expand[#9 #10 #11(#1 #2 + #3 #4) (#5 #6 + #7 #8)]}&;

AnswerFunction["factorisation: combined"]=
  {Factor[Expand[#9 #10 #11(#1 #2 + #3 #4) (#5 #6 + #7 #8)]]}&;


(* Algebra 1: "expansion of quadratics" *)

QuestionTemplate["expansion of quadratics"] =  
 "Expand the quadratic expression   `1`";

AnswerTemplate["expansion of quadratics"] =  
 "The expanded expression is   `1`";

ParameterSets["expansion of quadratics"] = 
  {{{x,y,p,t}},
   {WithoutReplacement[{1,2,3,4,5,6,7},4]},
   {{1,-1}},
   {{1,-1}}
  };

QuestionFunction["expansion of quadratics"]=
  {(#2 #1 + #3 #6) (#4 #1 + #5 #7)}&;

AnswerFunction["expansion of quadratics"]=
  {Expand[(#2 #1 + #3 #6) (#4 #1 + #5 #7)]}&;


(* Algebra 1: "x^2 + b x + c" *)

QuestionTemplate["x^2 + b x + c" ] =  
 "Factorise the quadratic expression   `1``2``3``4``5``6``7`";

AnswerTemplate["x^2 + b x + c"] =  
 "The factorised expression is   `1`";

ParameterSets["x^2 + b x + c"] = 
  {{{x,y,p,t}},
   {{-5,-4,-3,-2,-1,0,1,2,3,4,5}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5,6,7}}
  };

QuestionFunction["x^2 + b x + c"]=
  QuadraticInsertions[1,#2+#3,#2#3,#1]&;

AnswerFunction["x^2 + b x + c"]=
  {HoldForm[(#1+#2)(#1+#3)]}&;


(* Algebra 1: "a x^2 + b x + c" *)

QuestionTemplate["a x^2 + b x + c"] =  
 "Factorise the quadratic expression   `1``2``3``4``5``6``7`";

AnswerTemplate["a x^2 + b x + c"] =  
 "The factorised expression is   `1`";

ParameterSets["a x^2 + b x + c"] = 
  {{{x,y,p,t}},
   {WithoutReplacement[{1,2,3,4,5,6,7},4]},
   {{1,-1}},
   {{1,-1}}
  };

QuestionFunction["a x^2 + b x + c"]=
  QuadraticInsertions[#2 #4, #2 #5 #7+ #3 #6 #4,
    #3 #6 #5 #7, #1]&;

AnswerFunction["a x^2 + b x + c"]=
  {Factor[
    Expand[(#2 #1 + #3 #6) (#4 #1 + #5 #7)
    ]
  ]}&;

  
(* Algebra 2: "do to both sides 1" *)

QuestionTemplate["do to both sides 1"] =  
 "Solve for `1` the equation  
 `2`.";

AnswerTemplate["do to both sides 1"] =  
"The solution is   `1`.";

ParameterSets["do to both sides 1"] = 
  {{{a,b,c,l,m,n,p,q,r,s,t,x,y,z}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5}},
   {Integer,{-4,4}}
  };

QuestionFunction["do to both sides 1"]=
  {#1,#2#1+#3==#2#4+#3}&;

AnswerFunction["do to both sides 1"]=
  {#1==#4}&;


(* Algebra 2: "do to both sides 2" *)

QuestionTemplate["do to both sides 2"] =  
 "Solve for `1` the equation  
 `2`.";

AnswerTemplate["do to both sides 2"] =  
 "The solution is   `1`.";

ParameterSets["do to both sides 2"] = 
  {{{a,b,c,m,n,p,q,r,s,t,x,y,z}},
   {{-5,-4,-3,-2,2,3,4,5}},
   {WithoutReplacement[{-5,-4,-3,-2,2,3,4,5},2]},
   {{Times,Divide,Divide[#2,#1]&},{1,2,2}},
   {{Subtract}},
   {{False,True},{1,2}}
  };

QuestionFunction["do to both sides 2"]=
 {#1, If[#7,#5,#6][#2,If[#7,#6,#5][#1,#3]]==
  If[#7,#5,#6][#2,If[#7,#6,#5][#4,#3]]}&;

AnswerFunction["do to both sides 2"]=
  {#1==#4}&;


(* Algebra 2: "do to both sides 3" *)

QuestionTemplate["do to both sides 3"] =  
 "Solve for `1` the equation  
 `2`.";

AnswerTemplate["do to both sides 3"] =  
 "The solution is   `1`.";

ParameterSets["do to both sides 3"] = 
  {{{a,b,c,m,n,p,q,r,s,t,x,y,z}},
   {WithoutReplacement[{-5,-4,-3,-2,-1,1,2,3,4,5},2]},
   {{-12,-10,-9,-8,-6,-5,-4,-3,-2,-1,1,2,3,4,5,6,8,9,10,12}},
   {Integer,{-6,6}},
   {{Factor,Identity},{2,1}},
   {{Factor,Identity},{2,1}}
  };

QuestionFunction["do to both sides 3"]=
  {#1, #6[#2 #1 + #4] == #7[#3 #1 + (#2-#3)#5+#4]}&;

AnswerFunction["do to both sides 3"]=
  {#1==#5}&;


(* Algebra 2: "quadratic eqns 1" *)

QuestionTemplate["quadratic eqns 1"] =  
 "Solve the quadratic equation   `1``2``3``4``5``6``7` == 0.";

AnswerTemplate["quadratic eqns 1"] =  
 "The solutions are `1` == `2` and `1` == `3`.";

ParameterSets["quadratic eqns 1"] = 
  {{{x,y,p,t}},
   {{-5,-4,-3,-2,-1,0,1,2,3,4,5}},
   {{-5,-4,-3,-2,-1,1,2,3,4,5,6,7}}
  };

QuestionFunction["quadratic eqns 1"]=
  QuadraticInsertions[1,#2+#3,#2#3,#1]&;

AnswerFunction["quadratic eqns 1"]=
  {#1,-#2, -#3}&;


(* Algebra 2: "quadratic eqns 2" *)

QuestionTemplate["quadratic eqns 2"] =  
 "Solve the quadratic equation  
 `1``2``3``4``5``6``7` == 0";

AnswerTemplate["quadratic eqns 2"] =  
 "The solutions are   `1` == `2` and `1` == `3`";

ParameterSets["quadratic eqns 2"] = 
  {{{x,y,p,t}},
   {WithoutReplacement[{1,2,3,4,5,6,7},4]},
   {{1,-1}},
   {{1,-1}}
  };

QuestionFunction["quadratic eqns 2"]=
  QuadraticInsertions[#2 #4, #2 #5 #7+ #3 #6 #4,
    #3 #6 #5 #7, #1]&;

AnswerFunction["quadratic eqns 2"]=
  {#1,-#3 #6/#2,-#5 #7/#4}&;


(* Algebra 2: "completing the square" *)

QuestionTemplate["completing the square"] =  
 "Complete the square in the quadratic expression  
 `1``2``3``4``5``6``7`";

AnswerTemplate["completing the square"] =  
 "The new expression is   `1`";

ParameterSets["completing the square"] = 
  {{{x,y,p,t}},
   {{1,2,3,4,5}},
   {{-8,-7,-6,-5,-4,-3,-2,-1,1,2,3,4,5,6,7,8}/2},
   {{-6,-5,-4,-3,-2,-1,1,2,3,4,5,6}}
  };

QuestionFunction["completing the square"]=
  QuadraticInsertions[#2,2#2#3,#2#4,#1]&;

AnswerFunction["completing the square"]=
  {#2((#1 + #3)^2+#4-#3^2)}&;


(* Algebra 2: "quadratic eqns 3" *)

QuestionTemplate["quadratic eqns 3"] =  
 "Solve the quadratic equation  
 `1``2``3``4``5``6``7` == 0";

AnswerTemplate["quadratic eqns 3"] =  
 "The solutions are   `1` == `2` and `1` == `3`";

ParameterSets["quadratic eqns 3"] = 
  {{{x,y,p,t}},
   {{1,2,3}},
   {Integer,{-7,7}},
   {{1,2,3}},
   {{-1,1}}
  };

QuestionFunction["quadratic eqns 3"]=
  QuadraticInsertions[
    #2, 
    #5 Ceiling[N[2 Sqrt[Max[#2 #3,0]]] + #4], 
    #3, 
    #1]&;

AnswerFunction["quadratic eqns 3"]=
  {#1,
   Apply[
    Sequence,
    Simplify[#1/.Solve[
      #2 #1^2 + #5 Ceiling[N[2 Sqrt[Max[#2 #3,0]]] + #4] #1 + #3 == 0,
      #1]]
   ]}&;


(* End of Practice Question codes *)


(* Set Loaded flag *)
  algLoadedQ = True;

(* Everything OK---print message *)

  Print["Algebra function package loaded. Please continue."]