Iterációk, iterált pontsorozatok

1D

n-edik iterált
Legyen f, x rögzített.

x nulladik iterált: (f^((0)))[x]

      
1. iterált (f^((1)))[x] = f[x]
2. iterált (f^((2)))[x]=f [
          f [ x] ]

Nest[f, x, 3]

NestList[f, x, 3]

vektorértékû függvényekre is \(TraditionalForm\`F : ℝ\^2 -> ℝ\^2\)!

NestList[F, {x0, y0}, 2]

Kaczmarz-Steinhaus iteráció lin. egyr. megoldására

2D a

Steinhaus Iteráció, (gépi korlátok, buta gép)

Ax=b alak helyett <a1,x>=b1, <a2,x>=b2; megoldás hipersíkok metszete 

Közelítés merôleges vetítések egymás után történô elvégzésével

V1: elsô egyenesre vetítés
V2: második egyenesre vetítés

Iterált sorozat valamely kezdeti (x^((0))) vektorból:
{(x^((0))),  V1[(x^((0)))],  
        V2[V1 [(x^((0)))] ],  V1[V2[V1[(x^((0)))]]],   ... }

Példa: 
-x1+97x2=97
x1+x2=2

NSolve[{-x1 + 97  x2 == 97, x1 + x2 == 2}, {x1, 
        x2}]

Solve[{{y1 - x1, y2 - x2} . {97, 1} == 
          0, -y1 + 97  y2 == 97}, {y1, y2}]

P(x1,x2) V2-re vetített képének koordinátái: V2[P]={y1,y2}

Solve[{{y1 - x1, y2 - x2} . {1, -1} == 0, 
        y1 + y2 == 2}, {y1, y2}]

V1-re vetítés helyett csak y=1-re vetítünk:

V11[{x_, y_}] := {x, 1};

V2[{x_, y_}] := {(1/2) (2 + x - y), 
        (1/2) (2 - x + y)}

NestList[Composition[V2, V11], {0, 1}, 20] // N // 
      TableForm

Plot[{2 - x, (97 + x)/97}, {x, 0, 2}, 
        Epilog -> {RGBColor[1, 0, 0], 
            PointSize[ .02], (NestList[Composition[V2, V11], {0, 1}, 
                  20] /. {x_?NumberQ, y_?NumberQ} -> Point[{x, y}])}, 
        AspectRatio -> 1];

L = True;

V[v_] := If[L, L = False; V11[v], L = True; V2[v]]

Plot[{2 - x, (97 + x)/97}, {x, 0, 2}, 
        Epilog -> {RGBColor[1, 0, 0], 
            PointSize[ .02], (NestList[V, {0, 1}, 
                  20] /. {x_?NumberQ, y_?NumberQ} -> Point[{x, y}])}, 
        AspectRatio -> 1];

Miért mûködik? Kontrakció, távolságok csökkenek.

2D b

Elôzô variánsa: Most ténylegesen az elsô egyenesre vetítünk

Ax=b alak helyett <a1,x>=b1, <a2,x>=b2; megoldás hipersíkok metszete 
V1: elsô egyenesre vetítés
V2: második egyenesre vetítés

Példa: 
-x1+97x2=97
x1+x2=2

NSolve[{-x1 + 97  x2 == 97, 
        x1 + x2 == 2}, {x1, x2}]

V1[{x_, 
            y_}] := {((97 (-1 + 97 x + y))/9410), ((9409 + 97 x + y)/9410)};

V2[{x_, y_}] := {(1/2) (2 + x - y), 
        (1/2) (2 - x + y)}

(IS2b = NestList[Composition[V2, V1], {0, 1}, 20] // N) // 
      TableForm

L = True;

V[v_] := If[L, L = False; V1[v], L = True; V2[v]]

Plot[{2 - x, (97 + x)/97}, {x, 0, 2}, 
        Epilog -> {RGBColor[1, 0, 0], 
            PointSize[ .02], (NestList[V, {0, 1}, 
                  20] /. {x_?NumberQ, y_?NumberQ} -> Point[{x, y}])}, 
        AspectRatio -> 1];

Összevetés:

NSolve[{-x1 + 97  x2 == 97, 
        x1 + x2 == 2}, {x1, x2}]

Last[IS2b]

Miért mûködik? Kontrakció, távolságok csökkenek.

Composition[V2, V11][{x, 
        y}]

Norm[{1, 2} - {0, 0}]

N[%]

Norm[Composition[V2, V11][{1, 2}] - Composition[V2, V11][{0, 
            0}]]

Képek távolsága már 1–nél kisebb!

N[%]

1. egyenlet.
<a1,x>=b1
a11 x1+ a12 x2 -b1=0

Ekkor a geometriai megfontolások alapján a vetület koordinátái (ort. proj.+eltolás): n-egyenes normálvektora (pl. itt {a11,a12})

P '=V(P) =x-<x n>/<n,n> n+b1/<n,n>n ⟹ \(TraditionalForm\`x\_\(n + 1\) = 
        x\_n + \(\(\(\(b1\)\(-\)\) < 
                  a1, \(\(x\)\(>\)\)\)\/\(\(\(<\)\(a1\)\), , \(\(a1\)\(>\)\)\)\) a1\)

Példa a második egyenesre: x1+x2=1 a2={a21,a22}={1,1}

a2 = {1, 1}; b2 = 2;

v2[{x1_, x2_}] := {x1, x2} + (b2 - a2 . {x1, x2})/
          Norm[a2]^2

v2[{x1, x2}] // Expand

u = a2/Norm[a2]

P = IdentityMatrix[2] - (Transpose[{u}] . {u})

q2 = b2/Norm[a2] u;

P . {x1, x2} + q2

Ez ugyanaz, mint a V2 képlete. lehetôség mátrixokkal való kifejezére!

Q2=E-u uT+q2

3D

A=(({{7, 5, 2}, {8, 4, 9}, {11, 3, 3}}));b = {1, 2, 3};

LinearSolve[A, b]

N[%]

A sorainak normái

Sqrt[Plus @@ A[[1]]^2] // 
      N

MyNorm[
        v_] := (Sqrt[(∑_(i = 1)^(Length[v]))v[[i]]^2])

MyNorm[A[[1]]]

N[%]

norma1 = 
        N[MyNorm[
            A[[1]]]];
norma2 = 
        N[MyNorm[
            A[[2]]]];
norma3 = 
        N[MyNorm[A[[3]]]];

norma3

1/norma1 A[[1]]

1/norma2 A[[2]]

1/norma3 A[[3]]

e1 = A[[1]]/norma1; 
    e2 = A[[2]]/norma2; 
    e3 = A[[3]]/norma3;

β1 = 
      b[[1]]/norma1; β2 = 
      b[[2]]/norma2; β3 = 
      b[[3]]/norma3;

{e1}

Q1 = IdentityMatrix[3] - (Transpose[{e1}] . {e1}); 
    q1 = β1 e1;

Q2 = IdentityMatrix[3] - (Transpose[{e2}] . {e2}); 
    q2 = β2 e2;

Q3 = IdentityMatrix[3] - (Transpose[{e3}] . {e3}); 
    q3 = β3 e3;

q = Q3 . Q2 . q1 + Q3 . q2 + q3;

QCore[x_] := Q3 . Q2 . Q1 . x + q;

x = {0, 0, 0};

NestList[QCore, x, 100] // TableForm

Newton-Raphson

Adott f[x]=0 egy. továbbá egy \(TraditionalForm\`\(\(x\^*\)\(\ \)\)\)valós gyök "durva" közelítése

Pl x^2-2=0 x0=1

F[x]=x-f[x] / 'f ' [x]

Áll. Bizonyos feltételek mellett \(TraditionalForm\`\(F\^\((n)\)\)[x0]⟶\ \(x\^*\)\)

Példa.

NewtonRaphsonStep[x_] := 
        x - f[x]/f'[x];

f[x_] := x^2 - 2;
x0 = 2;

NestList[NewtonRaphsonStep, x0, 6]

N[%]

N[(Sqrt[2])]

Clear[x]

NewtonRaphsonStep[x] // Simplify

NestList[NewtonRaphsonStep, 17/12, 10] // N

Resolve[ForAll[x, x > Sqrt[2], 1/x + x/2 > Sqrt[2]], Reals]

Resolve[ForAll[x, 0 < x < Sqrt[2], 1/x + x/2 > Sqrt[2]], 
      Reals]

Resolve[ForAll[x, x > Sqrt[2], 1/x + x/2 - Sqrt[2] < x - Sqrt[2]], 
      Reals]

Vessük össze!

Solve[6 - x^2 == 3  x^2 - 3]

Solve[Cos[x] == x]

Oldjuk meg numerikusan, közelítsük a zérushely(ek)et iterációval, készítsünk ábrát a kezdõérték megállapítására!
Használhatjuk az ábrát egy kezdõérték abszcisszájának leolvasására is!

Plot[{Cos[x], x}, {x, -5, 5}, 
        PlotRange -> {-5, 5}];

Legyen f kétszer diff. ∃x∈[a,b]: f[x]=0? pl folytonossági megfontolások
Alapötlet: legyen (Subscript[x, 0])egy jó közelítése a gyöknek és használjuk a deriváltat egy jobb közelítés megadására

f' [
          (Subscript[x, n])] = (0 - f[(Subscript[x, n])])/((Subscript[x, n + 1]) - (Subscript[x, n]))⟹ (Subscript[x, n + 1]) = 
        (Subscript[x, n]) + ((-f [(Subscript[x, n])])/(f ')) [(Subscript[x, n])]

Egy lépés az iterációban (f globális)

x0 = 1;

    f[x_] := Cos[x] - x;

NewtonRaphsonStep[x_] := N[x - f[x]/f'[x]];

Nest[NewtonRaphsonStep, x0, 2]

FindRoot[f[x] == 0, {x, x0}]

NestList[NewtonRaphsonStep, x0, 3]

Ezt egy kicsit nehezebb megérteni, mindenki próbálkozzon azért!

NestWhile[NewtonRaphsonStep, x0, Unequal, 2]

Mathematica függvény

FindRoot[f[x] == 0, {x, x0}]

Feladat

Adjuk meg 3 tizedesjegy pontossággal, felhasználva a NewtonRaphsonStep fgv-t, az alábbi egyenletek összes zéróhelyét, melyek benne vanak a 0 3 sugarú környezetében.

eq1 = (x^2) == 5;

    eq2 = (x^3) == 2;

    eq3 = 
        4 x Cos[x]^2 + π/2 == 
          2  x  + Sin[2  x];

f[x_] := 
        4 x Cos[x]^2 + π/2 - (2  x  + Sin[2  x]);

Plot[f[x], {x, -3, 3}];

{Nest[NewtonRaphsonStep, -2, 3], Nest[NewtonRaphsonStep, 1, 3], 
      Nest[NewtonRaphsonStep, 2, 3]}

Projektmunka: NR Vizualizáció

Egy lépés viz.

Clear[f, g]

f[x_] := x^2 - 5;

g[x_] := x^3 - 2;

D[f[y], y]

NewtonRaphsonVis[f_, x0_] := 
      Module[{x}, 
        Plot[f[x], {x, x0 - 1, x0 + 1}, 
          PlotStyle -> {Thickness[ .01], RGBColor[0, 1, 0]}, 
          AspectRatio -> 1, 
          Epilog -> {RGBColor[1, 0, 0], 
              Line[{{x0, 
                    f[x0]}, {-f[x0]/(D[f[x], x] /. x -> x0) + 
                      x0, 0}}], Line[{{x0, 0}, {x0, f[x0]}}], 
              RGBColor[0, 0, 1], PointSize[ .03], 
              Point[{-f[x0]/(D[f[x], x] /. x -> x0) + x0, 
                  0}]}]]

NewtonRaphsonVis[f, 3];

Nest[NewtonRaphsonStep, 3, 1]

NewtonRaphsonVis[g, 2];

f globális

Clear[f]; f = g;

Nest[NewtonRaphsonStep, 2, 1]

Több lépés

f[x]

NewtonRaphsonVis[f_, x0_, step_] := 
      Module[{loctable = 
            Transpose[
              NestList[NewtonRaphsonStep, x0, step] /. x_ -> {x, f[x]}], 
          loctable2}, 
        loctable2 = Drop[loctable, 1] /. {x_?NumericQ, y_} -> {x, 0}; 
        Plot[f[x], {x, x0 - 4, x0 + 1}, 
          PlotStyle -> {Thickness[ .01], RGBColor[0, 1, 0]}, 
          AspectRatio ->  .75, 
          Epilog -> {RGBColor[1, 0, 0], PointSize[ .02], 
              Drop[loctable, -1] /. {x_?NumericQ, y_?NumericQ} -> 
                  Point[{x, y}], RGBColor[0, 0, 1], 
              loctable2 /. {x_?NumericQ, 0} -> Point[{x, 0}], 
              Map[Line[#] &, Transpose[{Drop[loctable, -1], loctable2}]], 
              Map[Line[#] &, Transpose[{Drop[loctable, 1], loctable2}]]}, 
          ImageSize -> {600, 600}]]

NewtonRaphsonVis[f, 5, 3];

NestList[NewtonRaphsonStep, 5, 3]

2D köv óra