Численные методы решения уравнений, + визуализация Опции

[junk]

Метод дихотомии (деления отрезка пополам)

Программа находит корень уравнения F(x) = 0, где F(x) - непрерывная на отрезке [a,b] функция, удовлетворяющая условию F(a)*F(B)<0. Для нахождения корня отрезок [a,b] делится пополам и выбирается тот полуинтервал, на концах которого знаки F(x) разные. Затем процесс деления повторяется до тех пор, пока длина интервала не станет меньше Eps.

{$n+}
Uses Crt;

Function f(x: Double): Double;
  Begin
    f := 1 / (Exp(x * Ln(2))) - 10 + 0.5*Sqr(x)
  End;

Var
  x, Eps, a, b, c: Double;
  n: Integer;

begin
  ClrScr;
  Writeln('Введите значения a и b'); Read(a, b);
  WriteLn('Введите точность Eps'); Read(Eps);

  n := 0;
  Repeat
    c := (a + b) / 2;
    If (f(a) * f©) < 0 Then b := c
    Else a := c;
    Inc(n)
  Until (b - a) <= Eps;

  x := (a + b) / 2;
  WriteLn('Корень равен  x=', x:10:7);
  WriteLn('Количество делений = ',n);
  ReadKey
end.

Метод хорд

{$n+}
Uses Crt;
Var
  x, Eps, a, b, c: Double;
  n: Integer;

Function f(x: Double): Double;
  Begin
    f := 1 / (Exp(x * Ln(2))) - 10 + 0.5*Sqr(x)
  End;

Function Chord(a, b: Double): Double;
  Begin
    Chord := (f(b)*a - f(a)*b) / (f(b) - f(a))
  End;

begin
  ClrScr;
  Writeln('Введите значения a и b');
  Read(a, b);

  WriteLn('Введите точность Eps');
  Read(Eps);

  ClrScr;
  n := 0;
  Repeat
    C := Chord(a, b);
    If f(a)*f© > 0 Then a := c
    Else b := c;
    Inc(n)
  Until Abs(Chord(a, b) - C) < Eps;

  x := c;
  WriteLn('Корень равен x=', x:10:7);
  WriteLn('Количество итераций =  ',n);
  ReadKey
end.

Метод Ньютона (касательных)

Действительный корень x уравнения F(x) = 0 вычисляется методом Ньютона по итерационному уравнению:
Xk+1 = Xk - F(Xk)/F'(Xk)

{$n+}
Function newton(start, Eps: Extended): Extended;
  Var
    X, prev: Extended;

  { Заданная функция }
  Function F(Arg: Extended): Extended;
    Begin
      F := Sqr(Arg) - 2
    End;

  { Производная заданной функции }
  Function Deriv(Arg: Extended): Extended;
    Begin
      Deriv := 2 * Arg
    End;

  Begin
    X := start;
    Repeat
      prev := X;
      X := prev - F(prev) / Deriv(prev);
    Until Abs(X - prev) <= Eps;
    newton := X
  End;

Var a, Eps: Extended;

begin
  WriteLn('Введите начальное приближение a');
  Read(a);
  WriteLn('Введите точность Eps');
  Read(Eps);

  WriteLn('Корень равен x= ', newton(a, Eps):10:7);
end.

Метод Ньютона с аппроксимацией производной

Если вычисление производной в методе Ньютона затруднено, можно заменить ее вычисление оценкой:
F'(X)= (F(X+h)-F(X))/h

{$n+}
Function newton(start, Eps: Extended): Extended;
  Var
    X, prev: Extended;

  Function noDeriv(Arg: Extended): Extended;

    Function F(Arg: Extended): Extended;
      Begin
        F := 1 / (Exp(arg * Ln(2))) - 10 + 0.5*Sqr(arg)
      End;

    Begin
      noDeriv := -2 * Eps * F(Arg) / (F(Arg + eps) - F(Arg - eps))
    End;

  Begin
    X := start;
    Repeat
      prev := X;
      X := prev + noDeriv(prev)
    Until Abs(X - prev) <= Eps;
    newton := X
  End;

Var a, Eps: Extended;

begin
  WriteLn('Введите начальное приближение a');
  Read(a);
  WriteLn('Введите точность Eps');
  Read(Eps);

  WriteLn('Корень равен x= ', newton(a, Eps):10:7);
end.

[Jahnerus]

Метод половинного деления

Программа как и положено по теории находит сначала отрезки где функция меняет знак на противоположный (то есть - где лежит корень), потом находит этот корень и в заключении строит график.

Исходный код

uses crt, graph;

const
d1=-100; { Отрезок проверки }
d2=100;

var
x:real;
a:array [1..2, 1..255] of real;
b:boolean;
i,n:byte;
y1,y2,dr,md,maxx,maxy,maxx2,maxy2:integer;

function f(x:real):real;
begin { Нужная функция }
f:=sin(x/20)*20;
end;

procedure search(a,b:real; var x:real);
const e=0.0001; { e - Точность }
begin
repeat
x:=(a+b)/2;
if f(a)*f(x)>0 then a:=x else b:=x;
until abs(f(x))<e;
end;

begin
clrscr;
{
Определение отрезков в которых функция меняет знак
на противоположный, то есть отрезки где лежит корень
}
x:=d1;
if f(d1)>0 then b:=true;

repeat
if b=true then begin
if f(x)<0 then begin
n:=n+1;
a[2,n]:=x;

repeat
x:=x-0.1;
until f(x)>0;

a[1,n]:=x;
x:=a[2,n];
b:=false;
end;
end;

if b=false then begin
if f(x)>0 then begin
n:=n+1;
a[2,n]:=x;

repeat
x:=x-0.1;
until f(x)<0;
a[1,n]:=x;
x:=a[2,n];
b:=true;
end;
end;
x:=x+0.1;
until x>d2;

if n=0 then writeln('Корней нет !!!')
else begin
writeln('В уравнении F(x) на отрезке [',d1,',',d2,'] найдено ',
n,' корн(-ей/-я/-ь)');
for i:=1 to n do begin
search(a[1,i],a[2,i],x);
writeln('X',i,' = ',x:5:3);
end;
end;

writeln('Нажмите клавишу "Enter" для построения');
readln;
dr:=9;
md:=2;
initgraph(dr,md,'c:\bp\bgi');{c:\bp - папка куда установлен TP7.0}
setcolor(12);

maxx:=getmaxx;
maxy:=getmaxy;
maxx2:=maxx div 2;
maxy2:=maxy div 2;

{ось OY}
line(maxx2,0,maxx2,maxy);
line((maxx2)-4,10,maxx2,0);
line((maxx2)+4,10,maxx2,0);
line((maxx2)+10,5,maxx2+14,9);
line((maxx2)+14,9,maxx2+18,5);
line((maxx2)+14,9,maxx2+14,14);
{ось OX}
line(0,maxy2,maxx,maxy2);
line(maxx-10,maxy2-4,maxx,maxy2);
line(maxx-10,maxy2+4,maxx,maxy2);
line(maxx-15,maxy2-12,maxx-7,maxy2-20);
line(maxx-15,maxy2-20,maxx-7,maxy2-12);

{График уравнения}
x:=d1;
setcolor(15);
repeat
y1:=maxy2-round(f(x-1));
y2:=maxy2-round(f(x));
if (y1>0) and (y1<maxy) and (y2>0) and (y2<maxy) then
line((round(x-1)+maxx2),y1,round(x)+maxx2,y2);
x:=x+1;
until x>d2;
readln;
closegraph;
end.