Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Внимание! Есть замечания модератора по теме: Название темы по правилам форума должно адекватно отражать суть решаемой задачи/проблемы.
Старый 02.12.2012, 14:14   #1
X-el
Новичок
Джуниор
 
Регистрация: 02.12.2012
Сообщений: 2
По умолчанию найти корень уравнения с заданной точностью (Паскаль)

Не могу доделать программу
задание:
дано уравнение
Y=(a*b-x*x*Cos(X^(-a)))/((4*x*x+b*b)^0.5)
где X изменяется от Xn с шагом Dx
параметр A имеет M значений
b - корень уравнения e^x+x*x-2=0 (искать с точностью до Eps)

Y считается неправильно, полагаю из-за ошибочных процедур Equat и Tab

Код:
Program rgr;
Const Mmax=20;
type
Tmx=array [1..Mmax] of Extended;
Tmy=array [1..Mmax, 1..Mmax] of Extended;
Ter=Array [1..Mmax, 1..Mmax] of Integer;
Var
A, Mx: Tmx;
My: Tmy;
Xn, Xk, Dx, B, C, D, Xo, Eps, Z, Zt: Extended;
I,J,K,M,Err,Km: Integer;
Er: Ter;

Procedure DataIn(M: Integer; var A: Tmx);
Var
I:Integer;
Begin
For I:=1 to M do read(A[I]);
End;

Function F(X:Extended): Extended;
Begin
F:=exp(X)+X*X-2;
End;

Procedure Equat(Xo, Eps: Extended; Km: Integer; var Err: Integer; var Z: Extended);
Var
R: Extended;
M: Integer;
Begin
Err:=1;
For M:=1 to Km do
Begin
Z:=sqrt(-Xo+2);
R:=abs(Z-Xo);
Xo:=Z;
If R<Eps then 
Begin
M:=Km;
Err:=Err-1;
Exit
End
End
End;

Procedure Tab(B, Xn, Xk, Dx: Extended; M: integer; var Er:Ter; var A, Mx: Tmx; My:Tmy);
Var I, J: integer;
X,Y: Extended;
Begin
For J:=1 to M do
Begin
I:=1;
X:=Xn;
Er[J,I]:=0;
Repeat
If (2*X*X+B*B)>0 then
Y:=(A[J]*B-X*X*Cos(exp(ln(X))*(-A[J])))/(sqrt(4*x*x+B*B))
Else
Er[J,I]:=1;
Mx[I]:=X;
My[J,I]:=Y;
Inc(I);
X:=X+Dx;
Until X>Xk;
End;
End;

Procedure ResOut(Var Mx:Tmx; var A: Tmx; Var My: Tmy; Var Er: Ter; K: integer);
Var
I,J: integer;
Begin
For J:= 1 to M do
Begin writeln(' A[',J,']=',A[J]:8:4);
Writeln(' X ', '         Y  ');
For I:=1 to K do
If Er[J,I]=1 then
Writeln(Mx[I]:6:3,   '   oshibka dannyh')
Else
Writeln('Massive Mx', Mx[I]:6:3,  ' Massive My  ', My [J,I]:6:3);
End;
End;

Begin
Writeln('Vvedite znacheniya peremennyh: Xn, Xk, Dx, M');
Readln(Xn,Xk,Dx,M);
Writeln('Xn=',Xn:4:2,' Xk=', Xk:4:2,' Dx=', Dx:4:2,'  M=', M);
Writeln('Vvedite znacheniya: nachalnogo priblizheniya Xo, pogreshnosti Eps, predelnogo chisla ciklov Km');
Readln(Xo, Eps, Km);
Writeln('Xo=',Xo:7:3,' Eps=', Eps:7:5,' Km=', Km:3);
Writeln('vvedite massiv iz M elementov');
DataIn(M,A);
Equat(Xo, Eps, Km, Err, Z);
If Err = 1 then
begin
Writeln('Koren ne nayden za ',Km:2,' iteraciy');
Exit
End;
Zt:=F(z);
B:=Z;
Writeln('Koren B=',B:4:2,' Zt=',Zt:8:7);
Tab(B,Xn,Xk,Dx,M,Er,A,Mx,My);
K:=trunc((Xk-Xn)/Dx+1);
ResOut(Mx,A,My,Er,K);
Readln;
Readln;
End.
строго не судите, паскаль знаю всего пару месяцев

Последний раз редактировалось X-el; 02.12.2012 в 14:22.
X-el вне форума Ответить с цитированием
Старый 04.12.2012, 21:27   #2
X-el
Новичок
Джуниор
 
Регистрация: 02.12.2012
Сообщений: 2
По умолчанию

поднимаю тему
X-el вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Найти корень уравнения методом хорд alilar Помощь студентам 0 18.08.2012 16:39
Найти корень уравнения методом хорд ju1sick Помощь студентам 3 13.11.2011 14:42
Найти корень уравнения методом касательных sparkie Помощь студентам 0 23.06.2011 14:37
Найти корень уравнения методом итераций. MASOFF Помощь студентам 0 28.01.2011 16:42
найти корень уравнения (С++) jewels Помощь студентам 0 15.11.2009 18:17