(* :Author: Christopher Moretti *) 

(* :Summary: This package contains the command FirstDerivativeTest. *)

(* :History: Version 1.0 by Christopher Moretti, 1998 *)

Clear[LittleNewton]
LittleNewton[f_,{x_,s_},n_]:=
        Block[ {k,seed,d},
                seed=N[s,10];
                Do[
                        seed=N[seed-(( f/.x->seed)/(D[f,x]/.x->seed)),50];
                ,{k,1,n}];
                Return[seed];
                ];

Clear[FirstDerivativeTest]
FirstDerivativeTest[ f_,{x_,a_,b_},opts___]:=
        Block[ {g,crits,mat,m1,c,int,d1,i1,j1,cn},
        {int}={Intervals}/.{opts}/.Options[FirstDerivativeTest];
                                g=D[f,x];
                
    If[int==0,
      crits=Select[ Select[Union[{a},x/.Solve[g==0,x],{b}],Im[#1]==0&],
                                #1>=a && #1<=b &],
                        cn=Union[{a,b},
          
          N[Table[Round[10^6  LittleNewton[g,{x,a+(b-a)/int j1},30]]/10^6,{j1,
                0,
                int}],8]];crits=Select[ Select[Union[cn],Im[#1]==0&],
                                #1>=a && #1<=b &]];
                m1=Length[crits];
                
    mat={{"x-value","y-value","Extrema Type "},{"-------","-------",
          "-------------"}};
                Do[ c=crits[[i1]];AppendTo[mat,{c,f/.x->c,
                                        Which[c==a,
            If[ (g>0)/.x->(a+10^-6),"local minimum","local maximum",
              "undetermined"],
                                                c==b,
            If[ (g>0)/.x->(b-10^-6),"local maximum","local minimum",
              "undetermined"],
                                                c>a&&c<b,
            Which[( (g>0)/.x->(c-10^-6))&&((g<0)/.x->(c+10^-6)),
              "local maximum",( g<0/.x->(c-10^-6))&&((g>0)/.x->(c+10^-6)),
              "local minimum",((g>0)/.x->(c-10^-6))&&((g>0)/.x->(c+10^-6)),
              "not a local extrema",((g<0)/.x->(c-10^-6))&&((
                      g<0)/.x->(c+10^-6)),"not a local extrema"]]}],{i1,1,
        m1}];
                If[ int !=0,
      Print["Warning - numerical solutions used. Answers may be 
inaccurate."]];
                Print[TableForm[mat]];
                Plot[f,{x,a,b}];];
Options[FirstDerivativeTest]={Intervals->0};

FirstDerivativeTest::usage=
  "FirstDerivativeTest[f,{x,a,b}] tries to find the local maxima and minima 
of the function f as x goes from a to b exactly using calculus.
                The option Intervals->n will estimate the critical points of \
f using 
Newton's method using n equally spaced seed values in [a,b]."
                

(* Examples:
                FirstDerivativeTest[x^3 (1-x)^2,{x,-2,2}]
        
        FirstDerivativeTest[x Sin[x],{x,0,4Pi},Intervals->10]
*)