El algoritmo de Newton

AlgNewton.nb

(* $Id: AlgNewton.m  1995/11/9 *)

(*********************************************************************

        PostGrado del Curso de Mathematica
        
 *********************************************************************)


(* :Title: Algoritmo de Newton *)

(* :Author: Javier Soria *) 

(* :Summary: Calculo de raices mediante la aproximacion del Algoritmo de Newton
*)  

(* :Context: Directorio`AlgNewton` *)
(* set up the package context, included any imports *)

BeginPackage["AlgNewton`"]




(* usage messages for the exported functions and the context itself *)

AlgNew::usage = "Genera una animacion de las aproximaciones de la raiz. f es la 

funcion, x la variable, a el punto origen del algoritmo, c y cc son los extremos 

del dominio de f, o y oo son los extremos del rango de la imagen de f"

AlgNew2::usage = "Muestra las distintas aproximaciones en un grafico."



Begin["`Private`"]    (* begin the private context *)


AlgNew[f_,{x_,a_,n_},{c_,cc_,o_,oo_}]:=
Module[
    {p,b=f/.x->a,y,z=a,ff,ww,lista={},
    dd,ddd},
    ff=Plot[f,{x,c,cc},PlotRange->
        {{c,cc},{o,oo}},
            DisplayFunction->Identity];
    Do[
    p=D[f,x]/.x->z;
    y=p(x-z)+b;
    ww=Plot[y,{x,c,cc},PlotRange->
        {{c,cc},{o,oo}},
            DisplayFunction->Identity];
    z=-b/p+z;
    b=f/.x->z;
    ddd=Graphics[Line[{{z,0},{z,b}}]];
    dd=Graphics[
        Prepend[{Point[{z,0}]},
        PointSize[.02]]];
    Show[{ff,ww,dd,ddd},
    DisplayFunction->$DisplayFunction];
    AppendTo[lista,z],
    {k,1,n}
    ];
    Print[N[lista]];
    Print["Solución: ",FindRoot[f==0,{x,a}]]
];

AlgNew2[f_,{x_,a_,n_},{c_,cc_,o_,oo_}]:=
Module[
    {p,b=f/.x->a,y,z=a,ff,ww,lista={},
        lista2={},dd,ddd},
    ff=Plot[f,{x,c,cc},PlotRange->
        {{c,cc},{o,oo}},
            DisplayFunction->Identity];
    AppendTo[lista2,ff];
    Do[
    p=D[f,x]/.x->z;
    y=p(x-z)+b;
    ww=Plot[y,{x,c,cc},PlotRange->
        {{c,cc},{o,oo}},
            DisplayFunction->Identity];
    z=-b/p+z;
    b=f/.x->z;
    ddd=Graphics[Line[{{z,0},{z,b}}]];
    dd=Graphics[
        Prepend[{Point[{z,0}]},
        PointSize[.02]]];
    AppendTo[lista2,ddd];
    AppendTo[lista2,dd];
    AppendTo[lista2,ww];
    AppendTo[lista,z],
    {k,1,n}
    ];
    Show[lista2,
    DisplayFunction->$DisplayFunction];
    Print[N[lista]];
    Print["Solución: ",FindRoot[f==0,{x,a}]]
]