Harjoitus 7 -- Ratkaisut

1

Solve osaa ratkaista polynomiyhtälöitä, ainakin astelukuun 4 asti. Erikoistapauksissa korkeammankin asteen yhtälöt ratkeavat.

Clear[a,b,c,d,e,x];
Solve[a (x^3)+b (x^2)+c==0,x]
Solve[(x^7)+(x^6)+(x^5)+(x^4)+(x^3)+(x^2)+x+1==0,x]

Esim. trigonometristen funktioiden ja eksponenttifunktion kanssa Solve saattaa kohdata vaikeuksia, mutta voi pärjätäkin.

Solve[Exp[(x^2)]==2,x]

NSolve toimii kuten Solve, mutta antaa numeerisen approksimaation:

q=NSolve[10(x^3)-x==5,x]

Ratkaisu voidaan ottaa käyttöön sijoitusoperaattorilla /.

x0=x/.q[[1]] (* q[[1]] antaa edellisen sääntölistan 1. alkion, {x->-0.417830-0.650958 I} *)

Reduce muokkaa loogisia väittämiä yksinkertaisempaan muotoon, mikä joissain tapauksissa voi vaikuttaa yhtälön ratkaisemiselta.

Reduce[(x^2)==x]

Reduce[{x==-x+4,(x^2)==-x+a}]

Hankalan mallisia yhtälöitä voi ratkaista numeerisesti FindRoot-funktiolla. Se toimii kaikenlaisiin yhtälöihin, myös useammasta käskystä koostuvien funktioiden nollakohtien etsimiseen. Se vaatii alkuarvauksen (vrt. Newtonin menetelmä) tai kaksi (välinpuolitusmenetelmä).

Plot[x-Tan[x],{x,0,4π}]

FindRoot[x==Tan[x],{x,4}]

Seuraava funktio on täysin hatusta vedetty.

f[ϵ_]:=Module[{γ,δ},
{γ,δ}=x/.Solve[ϵ (x^2)-(Sqrt[ϵ])x+1==0,x];
If[Abs[δ]>0,δ=(δ^2),γ=(γ^2)];
Im[δ-γ]//N
];

Plot[f[ϵ],{ϵ,-10,10}]

FindRoot[f[ϵ],{ϵ,-4,-2}]

2

f[x_]=Cot[(x^2)]-x;
Plot[f[x],{x,0,π}]

Etsitään 1. nollakohta.

x0=0.6; (*alkuarvaus*)

Tangentti pisteeseen ((Subscript[x, 0]),f((Subscript[x, 0]))):

y=f'[x0](x-x0)+f[x0];

Tangentin ja x-akselin leikkauspiste: (ensimmäisen asteen polynomilla (suoralla) on vain yksi nollakohta, joten Solve-funktio antaa varmasti vain yhden ratkaisun. Se antaa ratkaisun muodossa {{x->...}}. Flatten-funktion poistaa ylimääräisen aaltosulkeet.

x1=x/.Flatten[Solve[y==0,x]]

Piirretään tangentti pisteeseen ((Subscript[x, 1]),f((Subscript[x, 1]))), lasketaan sen nollakohta (Subscript[x, 2]), jne... Etsitään nollakohta tarkkuuteen (10^(-10)) asti.

xi=x1;
While[Abs[f[xi]]>(10^(-10))(*jatketaan etsintään jos f[xi] poikkeaa nollasta yli (10^(-10))*),
y=f'[xi](x-xi)+f[xi];(*tangentin yhtälöä ja sen nollakohdan ratkaisua ei tarvitsisi kirjoittaa, sillä nollakohdallekin on olemassa kaava*)
xi=x/.Flatten[Solve[y==0,x]];Print[xi]]

Algoritmi vaati vain muutaman kierroksen.

Newtonin menetelmä voidaan kirjoittaa omaksi funktiokseen, joka ottaa argumentikseen alkuarvauksen. Käytetään tässä tangentin nollakohdan kaavaa (ks. luennot)

newton[z_]:=(xi=z;While[Abs[f[xi]]>(10^(-10)),
xi=xi-((f[xi])/(f'[xi]))];xi)

newton[0.3]

3

Lähtien liikkeelle jostain muuttujan arvosta (Subscript[z, 0]), lasketaan funktion arvoja pisteissä (Subscript[z, i])=(Subscript[z, 0])+i h, kunnes löydetään pari, jolle f((Subscript[z, i]))f((Subscript[z, i+1]))<0, ts. funktio vaihtaa merkkiään välillä [(Subscript[z, i]),(Subscript[z, i+1])]. Sovelletaan sitten Newtonin menetelmää alkuarvona (Subscript[z, i]).

z0=0.1;
h=0.1;

While[f[z0+h]f[z0]>0,Print[z0];z0+=h]

newton[z0]

Huom. Newtonin menetelmä ei suppene epäjatkuvuuskohtaan. Funktio cot (x^2)-x vaihtaa merkkiään välillä [1.7,1.8], mutta jos em. hakua sovelletaan tähän väliin, Newtonin menetelmä peruuttaa edelliseen nollakohtaan (ks. kuvaaja)

z0=1.0;

While[f[z0+h]f[z0]>0,z0+=h]
newton[z0]

Kirjoitetaan koko hakuprosessi omaksi funktiokseen:

newtonhaku[z_]:=Module[{z0},
z0=z;
While[f[z0+h]f[z0]>0,z0+=h];
newton[z0]]

newtonhaku[1.9]

4

Muodostetaan interpoloiva funktio tasaväliseen datapisteistöön. (huom. interpoloivalla funktiolla ei ole epäjatkuvuuskohtia)

a=0.1;b=2.0;
fx=Table[{x,f[x]},{x,a,b,0.1}];
j=Interpolation[fx];
Plot[{j[x],f[x]},{x,a,b}]

Muutetaan ratkaisufunktion rakennetta. Funktio voi ottaa argumentikseen toisen funktion.

findroot[g_,w_]:=Module[{xi},xi=w;While[Abs[g[xi]]>(10^(-10)),
xi=xi-((g[xi])/(g'[xi]))];
xi]

findroot[f,0.9]

Interpoloivalle funktiolle:

findroot[j,0.8]

Jotta tätä funktiota voisi käyttää, on nimettävä tutkittava funktio.

findroot[Cos,1.5]

5

Välinpuolitusmenetelmä. Kaksi alkuarvausta a ja b, a<b, joissa f saa erimerkkiset arvot:

a=1.8;b=2.4;
f[a]
f[b]

Etsitään nollakohta tarkkuudella (10^(-10)). Lasketaan funktion arvo välin keskipisteessä (Subscript[x, 0]). Jos f((Subscript[x, 0]))f(a)<0, niin f((Subscript[x, 0])) ja f(a) ovat erimerkkiset, ja f vaihtaa merkkiään välillä [a,(Subscript[x, 0])]. Tarkasteltavan välin siirto tapahtuu sijoittamalla välin keskipiste toiseksi päätepisteeksi. Yo. tapauksessa asetettaisiin b->(Subscript[x, 0]).

While[Abs[a-b]>(10^(-10)),
xi=(a+b)/2;
If[f[xi]f[a]<0,b=xi,a=xi];
];
xi

Kirjoitetaan tämä omaksi funktiokseen:

bisection[f_,z_,w_]:=
Module[{a,b,xi},
a=z;
b=w;
While[Abs[a-b]>(10^(-10)),
xi=(a+b)/2;
If[f[xi]f[a]<0,b=xi,a=xi];
];
xi]

bisection[f,1.8,2.4]