Каталог Рефератов - Разработка программного обеспечения для решения уравнений с одной переменной методом Ньютона (касательных)

	Информационно-образоательный портал
	Рефераты, курсовые, дипломы, научные работы,



МЕНЮ\|

поиск

Разработка программного обеспечения для решения уравнений с одной переменной методом Ньютона (касательных)

y: =0;

y: =yn;

Repeat

If ly < 0 then

begin

Line (317, y, 323, y);

Str (ly: 0: 1, st);

OutTextXY (285, y+7, st);

end;

ly: =ly-dly;

SetLineStyle (DottedLn, 0, NormWidth);

Line (323, y, 570, y); Line (70, y, 317, y);

SetLineStyle (SolidLn, 0, NormWidth);

y: =y+40;

Until (y > 360);

end;

{***************************************************************************}

procedure groffunc;

var l, y0: integer;

y1, y2, x, y, mx, my: real;

gr, grand: string;

{***************************************************************************}

function f (x: real): real;

begin

Case number of

1: f: =a*ln(b*x);

2: f: =a*sqr(x) +b*x+c;

end;

{***************************************************************************}

begin

If number=0 then OutTextXY(300, 20, 'Введите сначала данные в уравнение!!! ') else

begin

ClearDevice;

SetBKColor (black);

case number of

1: grand: =('y(x) =*ln(*x) ');

2: begin grand: =('y(x) =*sqr(x) +*x+');

str (c: 0: 2, gr); insert (gr, grand, 17); end;

end;

str (b: 0: 2, gr); insert (gr, grand, (6+number*4));

str (a: 0: 2, gr); insert (gr, grand, 6);

OutTextXY (300, 40, grand);

y1: =0; y2: =0;

x: =m;

Repeat

y: =f (x);

if y < y1 then y1: =y;

if y > y2 then y2: =y;

x: =x+0.01;

Until (x >= n);

my: =250/abs (y2-y1);

If (abs (m) > abs (n)) then mx: =250/abs (m) else

mx: =250/abs (n);

y0: =360-abs (Round (y1*my));

setka (y0, y2);

SetColor (blue);

Line (320, 360, 320, 90);

Line (70, y0, 590, y0);

Line (320, 90, 317, 93); Line (320, 90, 323, 93);

Line (590, y0, 587, y0-3); Line (590, y0, 587, y0+3);

OutTextXY (595, y0-5, 'x'); OutTextXY (315, 80, 'y');

OutTextXY (400, 450, 'Нажмите "Ввод" для выхода');

If Abs (m) > Abs (n) then y1: =Abs (m) else y1: =Abs (n);

SetColor (Red);

str (mass [i]: 5: 4, grand);

OutTextXY (300+Round ((250/y1) *mass [i]), 400, grand);

Line (320+Round ((250/y1) *mass [i]), y0, 320+Round ((250/y1) *mass [i]), 390);

For l: =1 to i-1 do

begin

SetColor (2+l);

Line (320+Round ((250/y1) *mass [l]), y0+10, 320+Round ((250/y1) *mass [l]), y0-10);

end;

x: =m;

Repeat

y: =f (x);

PutPixel (320+Round (x*mx), y0-Round (y*my), 15);

x: =x+0.01;

Until (x >= n);

ReadLn;

pro;

end;

{***************************************************************************}

procedure load_file_1;

var mistake: byte;

k: char;

st: string;

f: text;

begin

Repeat

If number = 1 then

WriteLn (' Введите промежутки [m, n] одного знака') else

WriteLn (' Введите промежутки [m, n] ');

WriteLn ('Нажмите "1" для ввода данных с клавиатуры');

WriteLn ('Нажмите "2" для ввода данных из файла');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Ввод: ');

{$I-}

ReadLn (m, n);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Ошибка ввода');

end;

'2': begin

WriteLn (' Нажмите "1" для указания расположения своего файла');

WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически');

k: =ReadKey;

If k = '1' then begin

WriteLn ('Введите путь к файлу с расширением. txt');

ReadLn (st);

Assign (f, st);

end else

If k = '2' then assign (f, 'c: \temp\my_stuff\m_n. txt');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then

WriteLn ('Файла не существует') else

begin

{$I-}

Read (f, m, n);

{$I+}

mistake: =IOResult; Close (f); If mistake <> 0 then

WriteLn ('Информация в файле не соответствует нужному типу') else

begin

WriteLn (m: 0: 2);

WriteLn (n: 0: 2);

end;

end; WriteLn ('Нажмите "Ввод для продолжения"'); ReadLn;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure load_file_2;

var mistake: byte;

k: char;

st: string;

f: text;

begin

Repeat

WriteLn ('Нажмите "1" для ввода с клавиатуры');

WriteLn ('Нажмите "2" для ввода данных из файла');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Ввод: ');

If number = 1 then {$I-} ReadLn (a, b) {$I+} else

If number = 2 then {$I-} ReadLn (a, b, c) {$I-};

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Ошибка ввода');

end;

'2': begin

WriteLn (' Нажмите "1" для указания расположения своего файла');

WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически');

k: =ReadKey;

If k = '1' then begin

WriteLn ('Введите путь к файлу расширением. txt');

ReadLn (st);

assign (f, st);

end else

If k = '2' then assign (f, 'c: \temp\my_stuff\a_b_c. txt');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then

WriteLn ('Файла не существует') else

begin

If number = 1 then {$I-} Read (f, a, b) {$I+} else

{$I-} Read (f, a, b, c); {$I+}

mistake: =IOResult; Close (f); If mistake <> 0 then

WriteLn ('Информация в файле не соответствует нужному типу') else

begin

WriteLn (a: 0: 2);

WriteLn (b: 0: 2);

If number = 2 then WriteLn (c: 0: 2);

end;

end; WriteLn ('Нажмите "Ввод для продолжения"'); ReadLn;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure load_file_3 (var E: real);

var mistake: byte;

k: char;

st: string;

f: text;

begin

Repeat

WriteLn ('Нажмите "1" для ввода данных с клавиатуры');

WriteLn ('Нажмите "2" для ввода данных из файла');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Ввод: ');

{$I-}

ReadLn (E);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Ошибка ввода');

end;

'2': begin

WriteLn (' Нажмите "1" для указания расположения своего файла');

WriteLn (' Нажмите "2" для ввода из файла, созданного автоматически');

k: =ReadKey;

If k = '1' then begin

WriteLn ('Введите путь к файлу с расширением. txt');

ReadLn (st);

assign (f, st);

end else

If k = '2' then assign (f, 'c: \temp\my_stuff\E. txt');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then

WriteLn ('Файла не существует') else

begin

{$I-}

Read (f, E);

{$I+}

mistake: =IOResult; Close (f); If mistake <> 0 then

WriteLn ('Информация в файле не соответствует нужному типу') else

begin

WriteLn (E: 0: 3);

end;

end; WriteLn ('Нажмите "Ввод для продолжения"'); ReadLn;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure save_file (E: real);

var k: char;

mistake: byte;

f: text;

st: string;

begin

Repeat

WriteLn (' Если хотите сохранить данные и результаты нажмите "1"');

WriteLn (' Если не хотите сохранять данные и результаты нажмите "2"');

k: =ReadKey;

Case k of

'1': begin

WriteLn (' Если хотите сохранить данные в указанные вами файлы нажмите "1"');

WriteLn (' Если хотите, чтобы сохранение произошло автоматически нажмите "2"');

k: =ReadKey;

If k = '1' then begin

Repeat

WriteLn ('Введите путь и имя файла c для сохранения промежутков [m, n] ');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

Write (f, m: 3, n: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

Repeat

If number = 1 then

WriteLn ('Введите путь и имя файла для сохранения коэффициентов "a", "b"')

else

If number = 2 then

WriteLn ('Введите путь и имя файла для сохранения коэффициентов "a", "b", "c"');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

If number = 1 then begin

Write (f, a: 3, b: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end else

If number = 2 then begin

Write (f, a: 3, b: 3, c: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

Repeat

WriteLn ('Введите путь и имя файла для сохранения погрешности "Е"');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

Write (f, E: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

Repeat

WriteLn ('Введите путь и имя файла для сохранения корня');

ReadLn (st);

Assign (f, st);

{$I-}

ReWrite (f);

{$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Файл не может быть создан') else

begin

Write (f, mass [i]: 3); Close (f); WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

Until mistake = 0;

end else

If k = '2' then begin

Assign (f, 'c: \temp\my_stuff\m_n. txt');

{$I-} ReWrite (f); {$I+}

mistake: =IOResult;

If mistake <> 0 then WriteLn ('Каталога для сохранения не существует') else

begin

Write (f, m, n); Close (f);

Assign (f, 'c: \temp\my_stuff\a_b_c. txt');

ReWrite (f); If number = 1 then Write (f, a, b) else

Write (f, a, b, c); Close (f);

Assign (f, 'c: \temp\my_stuff\E. txt');

ReWrite (f); Write (f, E); Close (f);

Assign (f, 'c: \temp\my_stuff\x. txt');

ReWrite (f); Write (f, mass [i]); Close (f);

WriteLn ('Информация сохранена. Нажмите "Ввод"'); ReadLn;

end;

'2': mistake: =0;

end;

Until mistake = 0;

end;

{***************************************************************************}

procedure equation_1;

var mistake, code_of: byte;

E, x1, root: real;

bool_of: boolean;

k: char;

{***************************************************************************}

begin

closegraph;

bool_of: =false;

Repeat

number: =1;

clrscr;

WriteLn (' Уравнение вида: y(x) =a*ln(b*x) ');

Repeat

load_file_1;

If m > n then begin

WriteLn ('Введите "m" < "n" ');

WriteLn ('Нажмите "Ввод" для подолжения'); ReadLn;

end else

If (m < 0) and (n >0) or (m = 0) or (n = 0) then

begin

WriteLn ('"m" и "n" должны быть одного знака и неравные 0');

WriteLn ('Нажмите "Ввод" для продолжения'); ReadLn;

end;

Until (((m < 0) and (n < 0)) or ((m > 0) and (n > 0))) and (m <= n);

Repeat

WriteLn ('Введите коэффициенты уравнения "a", "b"');

load_file_2;

If m*b <= 0 then begin

WriteLn ('попробуйте ввести "b" другого знака и неравное 0');

WriteLn ('Нажмите "Ввод" для продолжения'); ReadLn;

end;

Until m*b > 0;

If a = 0 then begin

WriteLn ('Все "x" на промежутке [',m: 0: 1,'; ',n: 0: 1,'] - решения уравнения');

number: =0; end else

begin

Repeat

WriteLn ('Введите погрешность "E"');

load_file_3 (E);

If E <= 0 then begin WriteLn ('Введите "Е" больше 0');

WriteLn ('Нажмите "Ввод" для продолжения"');

end;

Until E > 0;

i: =1;

If (a*ln(b*m) *(-a/sqr(m))) > 0 then begin mass [i]: =m; code_of: =1 end else

If (a*ln(b*n) *(-a/sqr(n))) > 0 then begin mass [i]: =n; code_of: =1 end else

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end;

If code_of = 1 then

begin

Repeat

x1: =mass [i] -a*ln(b*mass [i]) /(a/mass [i]);

root: =Abs (x1-mass [i]);

i: =i+1;

mass [i]: =x1;

Until root < E;

If (x1 < m) or (x1 > n) then

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end else

WriteLn ('Корнем уравнения y(x) =', a: 0: 1, '*ln(', b: 0: 1, '*x) является: ', x1: 5: 4);

end;

WriteLn ('Нажмите "Ввод"'); ReadLn; If code_of = 1 then save_file (E) else

WriteLn ('Так как уравнение не имеет корней, то сохранение не выполняется');

WriteLn ('Если хотите выйти, то нажмите "ESC"');

WriteLn ('Если хотите ввести другие данные, то нажмите "Ввод"');

k: =ReadKey;

code_of: =ord (k);

case code_of of

27: begin

bool_of: =true; graphica;

end;

13: bool_of: =false;

end;

Until bool_of;

end;

{***************************************************************************}

procedure equation_2;

var mistake, code_of: byte;

E, x1, root: real;

bool_of: boolean;

k: char;

{***************************************************************************}

begin

closegraph;

bool_of: =false;

Repeat

number: =2;

clrscr;

WriteLn (' Уравнение вида: y(x) =a*x^2+b*x+c');

Repeat

load_file_1;

If m > n then WriteLn ('Введите "m" < "n" ');

Until (m <= n);

WriteLn ('Введите коэффициенты уравнения "a", "b", "c"');

load_file_2;

If (a = 0) and (b = 0) and (c = 0) then begin

WriteLn ('Все "х" на промежутке [',m: 0: 1,'; ',n: 0: 1,'] - решения уравнения');

number: =0; end else

begin

Repeat

WriteLn ('Введите погрешность "Е"');

load_file_3 (E);

If E <= 0 then begin WriteLn ('Введите E > 0');

WriteLn ('Нажмите "Ввод" для продолжения');

end;

Until E > 0;

i: =1;

If (a*sqr(n) +b*n+c) *(2*a) >= 0 then begin mass [i]: =n; code_of: =1 end else

If (a*sqr(m) +b*m+c) *(2*a) >= 0 then begin mass [i]: =m; code_of: =1 end else

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end;

If code_of = 1 then

begin

Repeat

x1: =mass [i] -((a*sqr(mass [i]) +b*mass [i] +c) /(2*a*mass [i] +b));

root: =Abs (x1-mass [i]);

i: =i+1;

mass [i]: =x1;

Until (root < E);

If (x1 < m) or (x1 > n) then

begin WriteLn ('Уравнение не имеет корней'); number: =0; code_of: =0; end else

WriteLn ('Корнем уравнения y(x) =', a: 0: 1, '*x^2+', b: 0: 1, '*x+', c: 0: 1, ' является: ', x1: 0: 4);

end;

WriteLn ('Нажмите "Ввод"'); ReadLn; If code_of = 1 then save_file (E) else

WriteLn ('Так как уравнение не имеет корней, то сохранение не выполняется');

WriteLn ('Если хотите выйти, то нажмите "ESC"');

WriteLn ('Если хотите ввести другие данные, то нажмите "Ввод"');

k: =ReadKey;

code_of: =ord (k);

case code_of of

27: begin

bool_of: =true; graphica;

end;

13: bool_of: =false;

end;

Until bool_of;

end;

{***************************************************************************}

procedure key (p1: byte);

Var y1, y2: integer;

name: string;

i: byte;

begin

ClearDevice;

SetColor (white);

OutTextXY (250, 435, '"Ввод" - вход "z", "x" - перемещение по меню');

y1: =15;

y2: =70;

for i: =1 to 5 do

begin

Setcolor (blue);

Rectangle (16, y1-1, 251, y2-1);

RecTangle (17, y1-2, 252, y2-2);

RecTangle (18, y1-3, 253, y2-3);

SetFillStyle (1,lightblue);

Bar (15, y1, 250, y2);

case i of

1: Name: ='Cправка';

2: Name: ='y=a*ln(b*x) ';

3: Name: ='y=a*x^2+b*x+c';

4: Name: ='Построение графика';

5: Name: ='Выход';

end;

SetColor (white);

OutTextXY (45, y1+25, Name);

y1: =20+y2;

y2: =75+y2;

end;

SetColor (white);

p1: =p1-1;

Rectangle (18, 19+75*p1, 246, 66+75*p1);

end;

{***************************************************************************}

procedure help;

var st: string;

f: text;

y: integer;

mistake: byte;

begin

ClearDevice;

Assign (f, 'c: \temp\My_stuff\help. asc');

{$I-}

Reset (f);

{$I+}

mistake: =IOResult; SetTextStyle (0, 0, 0);

If mistake <> 0 then OutTextXY (250, 220, 'Файла не существует') else

begin

y: =0;

Repeat

y: =15+y;

ReadLn (f, st);

OutTextXY (45, y, st);

Until EOf (f);

Close (f);

end;

OutTextXY (400, 450, 'Нажмите "Ввод" для выхода');

ReadLn; pro;

end;

{***************************************************************************}

procedure eat (p2: byte; var bool: boolean);

begin

if p2=1 then help else

if p2=2 then equation_1 else

if p2=3 then equation_2 else

if p2=4 then groffunc else

if p2=5 then bool: =true;

end;

{***************************************************************************}

procedure pro;

var p, code: byte;

k: char;

bool: boolean;

begin

ClearDevice;

p: =1;

key (p);

bool: =false;

repeat

SetBKColor(lightgray);

SetTextStyle (1, 0, 4); SetColor (blue);

OutTextXY (390, 130, 'МЕНЮ');

SetTextStyle (0, 0, 0);

k: =ReadKey;

code: =ord (k);

Case code of

122: begin

p: =p-1; if p=0 then p: =5;

key (p);

end;

120: begin

p: =p+1; if p=6 then p: =1;

key (p);

end;

13: eat (p, bool);

end;

until bool;

CloseGraph;

end;

{***************************************************************************}

begin

title;

number: =0;

graphica;

end.

Страницы: 1, 2, 3

© 2003-2013
Рефераты бесплатно, курсовые, рефераты биология, большая бибилиотека рефератов, дипломы, научные работы, рефераты право, рефераты, рефераты скачать, рефераты литература, курсовые работы, реферат, доклады, рефераты медицина, рефераты на тему, сочинения, реферат бесплатно, рефераты авиация, рефераты психология, рефераты математика, рефераты кулинария, рефераты логистика, рефераты анатомия, рефераты маркетинг, рефераты релиния, рефераты социология, рефераты менеджемент.