Лабораторная работа №17Программа:
Program LABTR;
uses crt;
type funk=function (x:real):real;
var a,b,h:real; n:integer; s,perv,eps,eps1:real;
{$i F.PAS}
{$i pev1.pas}
{$i proctr.PAS}
begin
clrscr;
write('a=');
readln(a);
write('b=');
readln(b);
write('n=');
readln(n);
write('eps=');
readln(eps);
h:=(b-a)/n;
trap(a,b,h,n,F,S);
perv:=PERV1(b)-PERV1(a);
eps:= (s-perv)/perv;
writeln('s=',s:5:4, ' perv=' ,perv:5:4,' eps1=',eps1:10:9);
readln;
end.
Подпрограмма 1:
{$F+}
procedure trap(a,b,h:real; n:integer; F:FUNK; var S:real);
var x:real; i:integer;
begin
S:=(F(a)+F(b))/2;
x:=a;
for i:=1 to n-1 do begin
x:=x+h;
S:=S+F(x);
end;
S:=S*h;
end;
{$F-}
Подпрограмма 2:
{$F+}
FUNCTION f(x:real):real;
begin
f:=1/(x+1)*sqrt(x*x+1);
end;
{$F-}
Подпрограмма 3:
{$F+}
function perv1(x:real):real;
begin
perv1:=(ln((1+sqrt(2))/2)-ln((1-x+sqrt(2*(x*x+1)))/2*(x+1)))/sqrt(2);
end;
{$F-}
Алгоритм:
Метод Ньютона
Программа:
program newt;
uses crt;
type funk=function(x:real):real;
var x,a,b,del,eps:real; n:integer;
{$i newton.pas}
{$i f.pas}
{$i f1.pas}
begin
clrscr;
clrscr;
write('vvedite a=');
readln(a);
write('vvedite b=');
readln(b);
write('vvedite del=');
readln(del);
write('vvedite eps=');
readln(eps);
if f(a)*f(b)<=0 then begin x:=a;
newton(del,f,f1,x);
writeln('x=',x:4:2,' ','f(x)=',f(x):8:6); end;
else begin writeln('net kornei'); end;
readln;
end.
Подпрограмма 1:
{$F+}
procedure newton(del:real; f,f1:funk; var x:real);
begin
while abs(f(x))>del
do x:=x-f(x)/f1(x);
end;
{$F-}
Подпрограмма 2:
{$F+}
function f(x:real):real;
begin f:=2*x*sin(x)-cos(x);
end;
{$F-}
Подпрограмма 3:
{$F+}
function f1(x:real):real;
begin f1:=2*x*cos(x)+3*sin(x);
end;
{$F-}
Алгоритм:
Метод Деления Пополам
Программа:
program chislmet3;
uses crt;
type funk=function(x:real):real;
var a,b,eps,del,x:real;
{$i F.pas}
{$i MDP.pas}
begin
clrscr;
writeln('chislennie metodi');
write('nachalo otrezka a=');
readln(a);
write('konec otrezka b=');
readln(b);
write('pogreshnost eps=');
readln(eps);
write('pogreshnost del=');
readln(del);
if f(a)*f(b)<=0 then begin mdp(a,b,eps,del,f,x);
writeln ('x=',x:4:2,' f(x)=',f(x):8:6);
writeln('s tochnostji del=',del:5:3,' s tochnostji eps=',eps:5:3);
end
else writeln('kornej net');
readln;
end.
Подпрограмма 1:
{$F+}
function f(x:real):real;
begin
f:=(exp(x)+sqrt(1+exp(2*x))-2);
end;
{$F-}
Подпрограмма 2:
{$F+}
procedure mdp(a,b,eps,del:real; f:funk;var x:real);
begin
if f(a)*f(b)<=0
then repeat x:=(a+b)/2;
if f(a)*f(x)<=0
then b:=x
else a:=x
until( abs(b-a)<eps)
or (abs(f(x))<del)
else writeln('kornej net');
end;
{$F-}
Алгоритм:
Метод Интерации
Программа:
program lab19;
uses crt;
type funk=function(x:real):real;
var a,b,eps,x:real;fi1,f1:funk; n,i:integer;
{$i mps.pas}
{$i s.pas}
{$i p.pas}
begin
clrscr;
write('a=');
readln(a);
write('b=');
readln(b);
write('n=');
readln(n);
write('eps=');
readln(eps);
if f(a)*f(b)<=0 then
begin x:=a;
mps(n,eps,fi,x);
writeln('x=',x:5:4,' f(x)=',f(x):5:4,' pri eps=',eps:4:3);end
else begin
writeln('net kornei');
end;
readln;
end.
Подпрограмма 1:
procedure mps(n:integer; eps:real;fi:funk;
var x:real); var i:integer;
begin i:=0;
while abs(x-fi(x))<eps do
begin x:=fi(x);
i:=1;
if i>n then
writeln('iteracii iscerpani');
end;
end;
Подпрограмма 2:
{$f+}
function fi(x:real):real;
begin
fi:=cos(x)-1/(1+x);
end;
{$f-}
Подпрограмма 3:
{$f+}
function f(x:real):real;
begin
f:=1+sin(x)-ln(1+x);
end;
{$f-}
Алгоритм:
Date: 2015-12-24; view: 1347
|