добрый вечер. помогите,мне нужно написать на Pascal, как найти корень уравнения f(x)=0 тремя методами:
1.метод деления отрезков пополам
2.метод простой итерации
3.метод Ньютона.
помогите,пожалуйста)
нахождение корней нелинейного уравнения
-
- Сообщения: 5
- Зарегистрирован: 28 окт 2010, 16:52
метод половинного деления
program polovin_del;
uses crt;
var a, b, eps, c, x:real;
function f(x:real):real;
begin
{f:=x*x*x-2.92*x*x+1.4355*x+0.791136;} вставить свою функцию
end;
begin
clrscr;
writeln('vvod a, b, eps'); read(a, b, eps);
repeat c:=(a+b)/2;
if f(a)* f(b)<0 then b:=c else a:=c;
until b-a<eps;
x:=(a+b)/2; writeln ('x=', x);
repeat until keypressed;
end.
program polovin_del;
uses crt;
var a, b, eps, c, x:real;
function f(x:real):real;
begin
{f:=x*x*x-2.92*x*x+1.4355*x+0.791136;} вставить свою функцию
end;
begin
clrscr;
writeln('vvod a, b, eps'); read(a, b, eps);
repeat c:=(a+b)/2;
if f(a)* f(b)<0 then b:=c else a:=c;
until b-a<eps;
x:=(a+b)/2; writeln ('x=', x);
repeat until keypressed;
end.
-
- Сообщения: 5
- Зарегистрирован: 28 окт 2010, 16:52
простая итерация
uses crt;
const n=3;
type t=real;
var a:array[1..n,1..n] of t; x,y,b:array[1..n] of t;
al, s, eps:t;
i, j, k:integer;
begin
clrscr;
writeln('vvedite dannie');
for k:=1 to n do for j:=1 to n do
begin writeln('vvedite a[', k, ',',j,']');
read(a[k,j]) end;
writeln('vvedite eps'); read(eps); al:=0;
for k:=1 to n do for j:=1 to n do
al:=al+sqrt(a[k,j]);
al:=sqrt(al); i:=-1;
if al<1 then
begin
for k:=1 to n do x[k]:=b[k];
repeat s:=0; i:=i+1;
for k:=1 to n do
begin y[k]:=b[k];
for j:=1 to n do
y[k]:=y[k]+a[k,j]*x[j];
s:=s+sqr(x[k]-y[k]);
end;
for k:=1 to n do x[k]:=y[k];
until sqr(s)<eps*(1-al)/al;
writeln('ittaracionni process okonchen.chislo itteracii=',i);
writeln('reshenie sistemy');
for k:=1 to n do
begin if j<0 then j:=0;
writeln('x[',k,']=',x[k]) end;
end
else writeln('uslovia dxodimostipo evklidnoimetrike ne vipolnjrtcj');
repeat until keypressed;
end.
uses crt;
const n=3;
type t=real;
var a:array[1..n,1..n] of t; x,y,b:array[1..n] of t;
al, s, eps:t;
i, j, k:integer;
begin
clrscr;
writeln('vvedite dannie');
for k:=1 to n do for j:=1 to n do
begin writeln('vvedite a[', k, ',',j,']');
read(a[k,j]) end;
writeln('vvedite eps'); read(eps); al:=0;
for k:=1 to n do for j:=1 to n do
al:=al+sqrt(a[k,j]);
al:=sqrt(al); i:=-1;
if al<1 then
begin
for k:=1 to n do x[k]:=b[k];
repeat s:=0; i:=i+1;
for k:=1 to n do
begin y[k]:=b[k];
for j:=1 to n do
y[k]:=y[k]+a[k,j]*x[j];
s:=s+sqr(x[k]-y[k]);
end;
for k:=1 to n do x[k]:=y[k];
until sqr(s)<eps*(1-al)/al;
writeln('ittaracionni process okonchen.chislo itteracii=',i);
writeln('reshenie sistemy');
for k:=1 to n do
begin if j<0 then j:=0;
writeln('x[',k,']=',x[k]) end;
end
else writeln('uslovia dxodimostipo evklidnoimetrike ne vipolnjrtcj');
repeat until keypressed;
end.
-
- Сообщения: 5
- Зарегистрирован: 28 окт 2010, 16:52
метод ньютона
uses crt;
var a, b, h1, h2, y, y0, y1, y2, t, x:real;
begin
clrscr;
writeln('zadaute konci otrezka');
readln(a,b);
writeln('schag tablici');
readln(h1);
writeln('vvedite novii schg tablici');
readln(h2);
writeln('znachenie funkcii v nachalnoi tochke');
readln(y0);
writeln('konichnie raznosti 1 i 2 porjdka');
readln(y1, y2);
x:=a;
writeln(' x', ' y' );
repeat
t:=(x-a)/h1;
y:=y0+t*y1+t*(t-1)*y2/2;
writeln(x:6:3, ' ',y:9:6);
x:=x+h2;
until x-(b+h2/10)>0;
readkey;
end.
uses crt;
var a, b, h1, h2, y, y0, y1, y2, t, x:real;
begin
clrscr;
writeln('zadaute konci otrezka');
readln(a,b);
writeln('schag tablici');
readln(h1);
writeln('vvedite novii schg tablici');
readln(h2);
writeln('znachenie funkcii v nachalnoi tochke');
readln(y0);
writeln('konichnie raznosti 1 i 2 porjdka');
readln(y1, y2);
x:=a;
writeln(' x', ' y' );
repeat
t:=(x-a)/h1;
y:=y0+t*y1+t*(t-1)*y2/2;
writeln(x:6:3, ' ',y:9:6);
x:=x+h2;
until x-(b+h2/10)>0;
readkey;
end.