Нахождение с заданной точностью корня уравнения F(x)=0 на промежутке [a;b] методом касательных (Ньютона): Отчет по учебно-вычислительной практике, страница 2

Приложение

program practica;

uses crt,graph;

type massiv=array[1..1000] of char;

massiv1=array[1..100] of real;

const a=-1;b=8;

var i,l,j,g,v,gd,gm,kx,ky,k,pox,poy,mx,my,kor,cas:integer; x,eps1,eps2,y1,y2,h,x1,x2,c0,c:real; st:string;

f:text;

mas:massiv;

mas1:massiv1;

function fun(z:real):real;

begin

fun:=0.9*sqr(z)*z-7*sqr(z)+5.9*z+1.5;

end;

procedure zvuk_in;

begin

sound(2500);

delay(2000);

sound(5000);

delay(2000);

sound(7500);

delay(2000);

nosound;

end;

procedure zvuk_out;

begin

sound(7500);

delay(2000);

sound(5000);

delay(2000);

sound(2500);

delay(2000);

nosound;

end;

procedure avtor;

begin clrscr;

gd:=detect;

initgraph(gd,gm,'c:\bp\bgi');

setbkcolor(2);

setcolor(14);

outtextxy(80,70,'Бурлов Александр Сергеевич');

outtextxy(80,90,'Radist Company');

outtextxy(80,110,'Уральский Государственный Технический Университет УГТУ-УПИ');

outtextxy(80,130,'Филиал в г.Краснотурьинске');

outtextxy(80,150,'All rights reserved. Смотри не нарушай! 2003');

setcolor(4);

outtextxy(290,262,'radio');

outtextxy(320,272,'fuck');

outtextxy(288,315,'Р-231КТ');

setcolor(15);

rectangle(280,240,360,300);

rectangle(287,247,353,293);

line(280,240,287,247); line(280,300,287,293);

line(360,300,353,293); line(360,240,353,247);

line(280,240,305,225); line(360,240,370,225);

line(370,225,370,275); line(305,225,370,225);

line(370,275,360,300); line(265,305,365,305);

line(265,305,265,330); line(360,335,365,335);

line(365,335,365,305); line(365,305,385,275);

line(365,335,385,305); line(385,306,385,275);

line(385,275,370,275); line(265,305,279,284);

line(260,330,360,330); line(260,330,240,355);

line(360,330,340,355); line(240,355,340,355);

line(360,340,340,360); line(240,360,340,360);

line(240,360,240,355); line(340,360,340,355);

line(360,340,360,330);

readkey;

zvuk_out;

closegraph;

end;

procedure zadanie;

begin clrscr;

assign(f,'c:\zadanie.txt');

reset(f);

i:=0;

textcolor(10);

while not(eof(f)) do begin

i:=i+1;

read(f,mas[i]);

write(mas[i]);

end;

readkey;

zvuk_out;

close(f);

end;

procedure graphik;

begin clrscr;

gd:=detect;

initgraph(gd,gm,'c:\bp\bgi');

setbkcolor(15);

setcolor(8);

if graphresult<>0 then

writeln('Ошибка №=',graphresult)

else begin

g:=getmaxx;

v:=getmaxy;

pox:=getmaxx div 2;

poy:=getmaxy div 2;

line(0,poy,g,poy);

line(g,poy,g-5,poy-2);

line(g,poy,g-5,poy+2);

line(pox,0,pox,v);

line(pox,0,pox-2,5);

line(pox,0,pox+2,5);

outtextxy(g-7,poy+4,'x');

outtextxy(pox-13,0,'y');

k:=0;

mx:=30;

my:=30;

kx:=pox;

while kx<g do begin

line(kx,poy-2,kx,poy+2);

str(k,st);

outtextxy(kx-7,poy+5,st);

k:=k+1;

kx:=kx+mx;

end;

k:=-1;

kx:=pox-mx;

while kx>0 do begin

line(kx,poy-2,kx,poy+2);

str(k,st);

outtextxy(kx-11,poy+5,st);

k:=k-1;

kx:=kx-mx;

end;

k:=1;

ky:=poy-my;

while ky>0 do begin

line(pox-2,ky,pox+2,ky);

str(k,st);

outtextxy(pox-10,ky-3,st);

k:=k+1;

ky:=ky-my;

end;

k:=-1;

ky:=poy+my;

while ky<v do begin

line(pox-2,ky,pox+2,ky);

str(k,st);

outtextxy(pox-18,ky-3,st);

k:=k-1;

ky:=ky+my;

end;

x:=-1;

while x<=8 do begin

kx:=round(pox+mx*x);

ky:=round(poy-my*(fun(x)));

putpixel(kx,ky,8);

delay(25);

x:=x+0.001;

end;

readkey;

zvuk_out;

end;

closegraph;

end;

procedure reshenie;

label 11,22;

begin clrscr;

textcolor(2);

writeln('введите границы интервала, шаг табулирования и точность расчета корней');

writeln('a=',a);

writeln('b=',b);

write('h=');

readln(h);

write('eps1=');

readln(eps1);

write('eps2=');

readln(eps2);

kor:=0; x1:=a; x2:=x1+h;

while x2<=b do begin

y1:=fun(x1);

y2:=fun(x2);

if y1*y2<0 then begin

kor:=kor+1;

begin

l:=0;

if fun(x1)*fun(x2)<0 then begin

c0:=x1;

if fun(c0)*(5.4*c0-14)<0 then c0:=x2;

22:

c:=c0-fun(c0)/(2.7*sqr(c0)-14*c0+5.9);

l:=l+1;

mas1[l]:=c;

if abs(c-c0)>eps1 then begin

c0:=c;

goto 22;

end;

write(kor,'-й корень при точности eps1=',eps1:1:4,' ');

writeln(c:1:8);

end;

writeln('все приближения к этому корню');

for j:=1 to l do

writeln('mas1[',j,']=',mas1[j]:1:8);

writeln;

l:=0;

if fun(x1)*fun(x2)<0 then begin

c0:=x1;

if fun(c0)*(5.4*c0-14)<0 then c0:=x2;

11:

c:=c0-fun(c0)/(2.7*sqr(c0)-14*c0+5.9);

l:=l+1;

mas1[l]:=c;

if abs(c-c0)>eps2 then begin

c0:=c;

goto 11;

end;

write(kor,'-й корень при точности eps2=',eps2:1:4,' ');

writeln(c:1:8);

end;

writeln('все приближения к этому корню');

for j:=1 to l do

writeln('mas1[',j,']=',mas1[j]:1:8);

writeln;

readln;

end;

end;

x1:=x2;

x2:=x1+h;

end;

readkey;

zvuk_out;

end;

begin

repeat

clrscr;

writeln;

writeln;

writeln;

textcolor(14);

writeln('                                                *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *');

writeln('                                                *                                                                   *');

writeln('                                                *                                ГЛАВНОЕ МЕНЮ                                                                   *');

writeln('                                                *                           1.Автор                                                                   *');

writeln('                                                *                           2.Задание                                                                   *');

writeln('                                                *                           3.График функции                                                                   *');

writeln('                                                *                           4.Решение                                                                   *');

writeln('                                                *                           5.Выход                                                                                                                                                     *');

writeln('                                                *                                                                                                                                                     *');

writeln('                                                *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *                                                                                                                                                     *');

textcolor(12);

write('Выберете любой пункт меню и увидете результат: ');

readln(cas);

zvuk_in;

case cas of

1:avtor;

2:zadanie;

3:graphik;

4:reshenie;

end;

until cas=5;

end.