Найти корень уравнения методом хорд.
Будем искать корень функции f(x). Выберем две начальные точки C1(x1;y1) и C2(x2;y2) и проведем через них прямую. Она пересечет ось абсцисс в точке (x3;0). Теперь найдем значение функции с абсциссой x3. Временно будем считать x3 корнем на отрезке [x1;x2]. Пусть точка C3имеет абсцисcу x3 и лежит на графике. Теперь вместо точек C1 и C2 мы возьмём точку C3 и точку C2. Теперь с этими двумя точками проделаем ту же операцию и так далее, т.е. будем получать две точки Cn + 1 и Cn и повторять операцию с ними. Таким образом мы будем получать две точки, отрезок, соединяющий которые, пересекает ось абсцисс в точке, значение абсциссы которой можно приближенно считать корнем. Эти действия нужно повторять до тех пор, пока мы не получим значение корня с нужным нам приближением. (источник)
function f(x:real):real;
begin
f:=x*x*x+x-5;
end;
var xn,xk,p,e:real;
begin
e:=0.001;
xn:=0.5;
xk:=2;
repeat
p:=(f(xk)*xn-f(xn)*xk)/(f(xk)-f(xn));
if abs(f(p))<=e then
begin
writeln('x=',p);
readln;
exit;
end;
if f(xn)*f(xk)>0 then xn:=p else xk:=p;
until abs((f(xk)*xn-f(xn)*xk)/f(xk)-f(xn)-p)<=e;
writeln('x=',p);
readln
end.
Здравствуйте. Помогите набросать программный код по следующей блок-схеме: http://www.mathros.net.ua/znahodzhennja-nablyzhenogo-rozvjazku-nelinijnogo-algebraichnogo-rivnjannja-metodom-hord.html
Исправил программу на сайте сделал проще и удобнее
согласно ссылке на сайт с описание алгоритма получается в onlinegdb.com следующая программа,
function f(x:real):real;
begin
f:=x*x*x+x-5;
end;
var xn,xk,p,e:real;
begin
e:=0.001;
xn:=0.5;
xk:=2;
repeat
p:=(f(xk)*xn-f(xn)*xk)/(f(xk)-f(xn));
if abs(f(p))<=e then begin writeln('x=',p); readln; exit; end; if f(xn)*f(xk)>0 then xn:=p else xk:=p;
until abs((f(xk)*xn-f(xn)*xk)/f(xk)-f(xn)-p)<=e; writeln('x=',p); readln end. Этот пример работает, а согласно блок-схеме на сайте (http://www.mathros.net.ua) не правильно работает алгоритм. Внизу программа под данную блок-схему со всеми переменными, условиями и циклами
function f(x:real):real;
begin
f:=x*x*x-x-5;
end;
var x0,xp,xn,a,b,c,r,x,eps:real;
begin
eps:=0.001;
a:=0.5;
b:=2;
if f(a)*f(b)<0 then
begin
x0:=a;
c:=b;
end else
begin
x0:=b;
c:=a;
end;
xp:=x0;
repeat
begin
xn:= xp-f(xp)*(c-xp)/(f(c)-f(xp));
r:=xn-xp;
xp:=xn;
end;
until abs(r)<=eps; x:=xp; writeln('x=',x); end.
Спасибо retros. Вы меня очень выручили. Буду советовать Ваш ресурс коллегам.