Помощь - Поиск - Пользователи - Календарь
Полная версия: Численные методы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
AlaRic
Написать программу решения нелинейных уравнений методом хорд.
AlaRic
Никто?
Gid
Ну я забыл :-/
Ладно теперь вспомнил! smile.gif
Подумаю на досуге
___ALex___
                                                 
//___методы решения нелинейных одиночных уравнений___//

//метод деления отрезка пополам(метод бисекции)
Код

function MetDelOtrPop(a, b, eps: Extended): Extended;
var
c, Fa: Extended;

function Func(Arg: Extended): Extended;
begin

Result := Arg - Sin(Arg) - 0.25;//здесь указывается нужная ф-ия

end;

begin

Fa := Func(a);
repeat
 c := (a + B) / 2;
 if Fa * Func© > 0 then a := c else b := c;
until Abs(Func©) <= eps;
Result := c;

end;


//метод хорд
Код

function MetHord(a, b, eps: Extended): Extended;
var
Pribl, PredPribl: Extended;

function Func(x: Extended): Extended;
begin

Result := Sqr(x) - 2;//здесь указывается нужная ф-ия

end;

begin

Pribl := b;
repeat
 PredPribl := Pribl;
 Pribl := PredPribl - (a - PredPribl) * Func(PredPribl) / (Func(a) - Func(PredPribl));
until Abs(Pribl - PredPribl) <= eps;
Result := Pribl;

end;

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

function MetNewtona(nachpribl, eps: Extended): Extended;
var
Pribl, PredPribl: Extended;

function Func(Arg: Extended): Extended;
begin

Result := Sqr(Arg) - 2;//здесь указывается нужная ф-ия

end;

function ProizvFunc(Arg: Extended): Extended;
begin

Result := 2 * Arg;//здесь указывается производная нужной ф-ии

end;

begin

Pribl := nachpribl;
repeat
 PredPribl := Pribl;
 Pribl := PredPribl - Func(PredPribl) / ProizvFunc(PredPribl);
until Abs(Pribl - PredPribl) <= eps;
Result := Pribl;

end;

//модификация метода Ньютона 1(применяется когда нельзя получить производную функции)
Код

function MetNewtona(nachpribl, eps: Extended): Extended;
var
Pribl, PredPribl: Extended;

function Nevyazka(Arg: Extended): Extended;

function Func(Arg: Extended): Extended;
begin

Result := Sqr(Arg) - 2;//здесь указывается нужная ф-ия

end;

begin

Result := -2 * eps * Func(Arg) / (Func(Arg + eps) - Func(Arg - eps));

end;

begin

Pribl := nachpribl;
repeat
 PredPribl := Pribl;
 Pribl := PredPribl + Nevyazka(PredPribl);
until Abs(Pribl - PredPribl) <= eps;
Result := Pribl;

end;

//модификация метода Ньютона 2(метод Рыбакова)

Код

type
ArrayResh = Array of Extended;

function MetRib(a, b, eps: Extended; M: LongWord): ArrayResh;
var
x, dx: Extended;
Sch: LongWord;
CheckOnOut: Boolean;

function Func(Arg: Extended): Extended;
begin

Result := Sqr(Arg) - 2;//здесь указывается нужная ф-ия

end;

begin

Sch := 0;
x := a;
 repeat
  repeat
   dx := Abs(Func(x)) / M;
   x := x + dx;
   if dx <= eps then CheckOnOut := True else CheckOnOut := False;
  until CheckOnOut or (x > B);
  if CheckOnOut then
   begin
    Inc(Sch);
    SetLength(Result, Sch);
    Result[Sch - 1] := x;
    x := x + 20 * eps;
   end;
 until x > b;

end;

//метод простой итерации
Код

function SimpleIter(nachpribl, eps: Extended): Extended;
var
Pribl1, Pribl2: Extended;

function NeedFunc(x: Extended): Extended;
begin

Result := Sin(x) + 0.25;//здесь указывается нужная ф-ия

end;

begin

Pribl2 := nachpribl;
repeat
 Pribl1 := Pribl2;
 Pribl2 := NeedFunc(Pribl1);
until Abs(Pribl1 - Pribl2) <= eps;
Result := Pribl2;

end;


//комбинированный метод(метод хорд + метод касательных)
Код

function CombMet(a, b, eps: Extended): Extended;
var
PriblN, PriblH: Extended;

function Func(x: Extended): Extended;
begin

Result := Sqr(x) - 2;//здесь указывается нужная ф-ия

end;

begin

PriblN := a;
PriblH := b;
repeat
 PriblH := PriblH - (PriblN - PriblH) * Func(PriblH) / (Func(PriblN) - Func(PriblH));
 PriblN := PriblN - 2 * eps * Func(PriblN) / (Func(PriblN + eps) - Func(PriblN - eps));
until Abs(PriblN - PriblH) <= eps;
Result := (PriblN + PriblH) * 0.5;

end;



вот
AlaRic
smile.gif
Zole
Текст программы:
Код

Program HORDA;
Uses crt;
  Function f(x:real):real;
     Begin
        f:=x*sin(x)-1; {вставь свою функцию}
     End;
  Function pr1(x:real):real;
     Begin
        pr1:=sin(x)+x*cos(x);{1 производная}
     End;
  Function pr2(x:real):real;
     Begin
        pr2:=2*cos(x)-x*sin(x);{2 производная}
     End;
Var x1,x2,c,E,a,b:real;
      n:integer;
Begin
   Clrscr;
     Writeln('Введите границы отрезка - а и b');
     Read(a,B);
     Writeln('Введите точность Е');
     Read(E);
          n:=0;
      if f(a)*f(B)<0 then begin
    repeat
      if pr1(a)*pr2(a)>0 then begin
          n:=n+1;
          x1:=a-(f(a)*(b-a))/(f(B)-f(a));
          x2:=x1-(f(x1)*(b-x1)/(f(B)-f(x1)));
          a:=x2;
                                                end
      else
          n:=n+1;
          x1:=b-(f(B)*(b-a))/(f(B)-f(a));
          x2:=x1-f(x1)*(x1-a)/(f(x1)-f(a));
          b:=x2;
                           end;
    until abs(x2-x1)<=E;
     Writeln('Корень уравнения х = ', x2:8:6);
     Writeln('Число итераций = ',n);
     Readln;
     Readln;
   End.

:p4:
Altair
А что в тег кода перестали помещать тексты программ?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.