Метод удвоения шага и метод бисекции

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, XPMan, ComCtrls, StdCtrls;

type

TForm1 = class(TForm)

edt1: TEdit;

edt2: TEdit;

ud1: TUpDown;

ud2: TUpDown;

xpmnfst1: TXPManifest;

lbl1: TLabel;

lbl2: TLabel;

mmo1: TMemo;

edt4: TEdit;

lbl4: TLabel;

ud4: TUpDown;

btn1: TButton;

btn2: TButton;

edt5: TEdit;

lbl5: TLabel;

procedure edt2Change(Sender: TObject);

procedure edt1Change(Sender: TObject);

procedure btn1Click(Sender: TObject);

procedure btn2Click(Sender: TObject);

procedure edt4Change(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var a,b,i,j:Integer; //нижняя и верхняя границы поиска + вспомогательные переменные

xa,x1,x2,xb,h,eps:Real; //Первоначальный шаг и заданная точность + вспомогательные переменные

Form1: TForm1;

implementation

{$R *.dfm}

function amount (x1, x2: real):real;

//Вычисление произведения значений функции в точках х1 и х2, чтобы потом определить его знак.

var am1, am2: Real;

begin

if x1=0 then x1:=1/eps; //Во избежание ошибки деления на ноль

am1:=Sqrt(1+x1)-(1/x1);

if x2=0 then x2:=1/eps;

am2:=Sqrt(1+x2)-(1/x2);

amount:=am1*am2;

if x1=1/eps then x1:=0;

if x2=1/eps then x2:=0;

end;

function equality (x1,x2,compa:real):Boolean; //compa = compared - сравнимая величина.

//Так как в силу специфики обработки компьютером чисел с плавающей точкой внезапно

var t:Real; //появляются миллиардные доли, мешающие сравнению, пришлось написать специальную функцию сравнения

begin

t:=10*eps;

if abs(x2-x1-compa)<1/t then equality:=true

else equality:=False;

end;

procedure TForm1.edt2Change(Sender: TObject);

begin

a:=StrToInt(edt1.Text); //Небольшой foolproof во избежание системных ошибок и нулевого числа срабатываний

b:=StrToInt(edt2.Text);

if a>=b then begin

ShowMessage ('Нижняя граница интервала не может быть меньше либо равна верхней!');

b:=a+1;

edt2.Text:=IntToStr(b);

end;

end;

procedure TForm1.edt1Change(Sender: TObject);

begin

a:=StrToInt(edt1.Text);

b:=StrToInt(edt2.Text);

if a>=b then begin

ShowMessage ('Нижняя граница интервала не может быть меньше либо равна верхней!');

//Небольшой foolproof во избежание системных ошибок и нулевого числа срабатываний

a:=b-1;

edt1.Text:=IntToStr(a);

end;

if a<-1 then begin

//А это - на случай, если кому вздумается ввести значение х, находящееся за пределами ОДЗ [-1; +inf)

ShowMessage('При x<(-1) функция не существует!');

a:=-1;

edt1.Text:=IntToStr(a);

end;

end;

procedure TForm1.btn1Click(Sender: TObject);

var found:Boolean; //Нашли ли мы промежуток с корнем?

begin

eps:=0.1;

for i:=0 to strtoint(edt4.Text) do eps:=eps*10;

a:=StrToInt(edt1.Text);

b:=StrToInt(edt2.Text);

h:=1;

if h>(b-a) then h:=(b-a)/2; //Небольшой foolproof на случай, если кому-то вздумается поставить шаг меньше, чем промежуток между a и b

xa:=a;

xb:=b;

j:=1;

x1:=xa;

x2:=xa+h;

while (x2<b) and (((equality(x1,x2,(1/eps)))=False) or (amount(x1,x2)>0)) do begin

//Зачем такое сложное условие? Да чтобы у меня: 1) Выводил "Нет корней", дойдя до верхней границы; 2) Не завершал сразу поиск, как только h=1/eps

if amount(x1,x2)<=0 then begin

found:=True;

if equality(x1,x2,h) then h:=h/10;

//Если разность между х2 и х1 равна h, и при этом х1 и х2 - границы интервала, содержащего корень, то уменьшаем h в десять раз для повышения точности

xa:=x1;

xb:=x2;

x2:=x1;

j:=1;

end;

x1:=x2;

x2:=x1+j*h;

j:=j*2;

if x2>xb then x2:=xb;

end;

if found=True then edt5.Text:='('+FloatToStr(x1)+' ; '+floattostr(x2)+')'

else edt5.Text:='В указанном промежутке нет корней';

end;

procedure TForm1.btn2Click(Sender: TObject);

var found:Boolean;

begin

eps:=0.1;

for i:=0 to strtoint(edt4.Text) do eps:=eps*10;

a:=StrToInt(edt1.Text);

b:=StrToInt(edt2.Text);

h:=(b-a)/2;

xa:=a;

xb:=b;

while (xb-xa)>1/eps do begin

//Тут простое условие, т.к. у нас нет такой величины, как размер шага.

if amount(xa,h)<0 then begin

xb:=h;

h:=(xa+xb)/2;

found:=true;

end

else if amount(h,xb)<0 then begin

xa:=h;

h:=(xa+xb)/2;

found:=true;

end

else begin

found:=False;

Break;

end;

end;

if found=True then edt5.Text:='('+FloatToStr(xa)+' ; '+floattostr(xb)+')'

else edt5.Text:='В указанном промежутке нет корней';

end;

procedure TForm1.edt4Change(Sender: TObject);

begin

if StrToInt(edt4.Text)>10 then begin

ShowMessage('Указанная степень точности слишком велика!');

edt4.Text:='10';

end;

end;

end

6. Тестовый пример

Рисунок 1 - вычисление интервала, содержащего корень, методом удвоения шага

Рисунок 2 - вычисление интервала, содержащего корень, методом бисекции

7. Проверка в MathCad

Рис.

1. Размещено на Allbest.ru