Páginas personales

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}]]
]
[Graphics:Images/Newton_gr_1.gif]

[Graphics:Images/Newton_gr_2.gif]

[Graphics:Images/Newton_gr_3.gif]

[Graphics:Images/Newton_gr_4.gif]

[Graphics:Images/Newton_gr_5.gif]

[Graphics:Images/Newton_gr_6.gif]

[Graphics:Images/Newton_gr_7.gif]

[Graphics:Images/Newton_gr_8.gif]

[Graphics:Images/Newton_gr_9.gif]
[Graphics:Images/Newton_gr_10.gif]
[Graphics:Images/Newton_gr_11.gif]

[Graphics:Images/Newton_gr_12.gif]

[Graphics:Images/Newton_gr_13.gif]
[Graphics:Images/Newton_gr_14.gif]

Converted by Mathematica      March 1, 2002