Новые сообщения · Правила  
  • Страница 1 из 1
  • 1
Модератор форума: Berestovskiy  
Турбо-паскаль, нужно переделать задачу.
Добрый вечер.
Кто сможет помочь переделать задачу:
Разработать схему алгоритма, составить Pascal-программу и Delphi-проект вычисления таблицы значений функции Y=f(X,A,B) при заданных изменениях значений аргумента X и параметра A. Параметр В принимает значения, численно равное корню нелинейного уравнения или интеграллу.
Обозначения:
Xn (An), Xk (Ak) - начально и конечное значения аргумента (параметра А)
Dx (Da) - шаг изменения аргумента (параметра)
N - число значений аргумента (параметра), изменяемого от значения Xn, (An) с шагом Dx (Da);
M - число значений аргумента (параметра), не зависящих друг от друга.

Изменяемые входные данные:
a)Аргумент X:
Xn, Dx, N
б)Параметр А:
An, Ak, Da
Табулируемая функция f(x,a,b):

tg(ax/b), при х<1
(sqrt(a^2 * x^4 + b^2))/x^3, при х>=1

Нелинейное уравнение.
Условие задачи: вычислить первый положительный корень уравнения F(x)=0 с заданной погрешностью E (E=10^-3 -:- 10^-6) на интервале [c,d]

e^cos(0.3x - 0.2) - ln(x+2.2)
Интервал изоляции [c,d]: 0, 9;

Интеграл
Условие задачи: вычислить приблеженно с заданной погрешностью E (тоже самое) значение определенного интеграла (знак интеграла, а внизу b сверху) f(x)dx

(((x^2)+x+2)^2)*cos(2x)

Пределы интегрирования:
a = 2.51
b = -0.69
(Дельфи не нужно)

Добавлено (18.12.11, 17:29)
---------------------------------------------
Вот мой вариант:

Code
Const
  a0=2.51;
  b0=-0.69;
Var
  x,a,b,Xn,Xk,Dx,An,Ak,Da:Real;
  Na,Nx,i,j:Byte;

Function I0(x:real):Real;
begin
  I0:=0.5*Sin(x*2);
end;

Function I1(x:real):Real;
begin
  I1:=Cos(x*2)/4+x*Sin(x*2)/2;
end;

Function I2(x:real):Real;
begin
  I2:=x/2*Cos(x*2)+(sqr(x)/2-0.25)*Sin(x*2);
end;

Function I3(x:real):Real;
begin
  I3:=(sqr(x)*0.75-0.375)*Cos(x*2)+(x*sqr(x)/2-0.75*x)*Sin(x*2);
end;

Function I4(x:real):Real;
begin
  I4:=sqr(sqr(x))*Sin(x*2)/2-2.0*((sqr(x)*0.75-0.375)*Sin(x*2)-(x*sqr(x)/2-x*0/75)*Cos(x*2));
end;

Function f(xf,af:real):real;
begin
  If xf<1 then f:=Sin(af*xf/b) else
  f:=Sqrt(sqr(af)*sqr(sqr(xf))+sqr(b))/xf/sqr(xf);
end;

BEGIN
  b:=(I4(b0)+I3(b0)*2+I2(b0)*5+I1(b0)*4+I0(b0)*4)-(I4(a0)+I3(a0)*2+I2(a0)*5+I1(a0)*4+I0(a0)*4);
  Write('Xn= ');
  Readln(Xn);
  Write('Xk= ');
  Readln(Xk);
  Write('Dx= ');
  Readln(Dx);
  Write('An= ');
  Readln(An);
  Write('Ak= ');
  Readln(Ak);
  Write('Da= ');
  Readln(Da);
  Nx:=ROUND((Xk-Xn)/Dx);
  Na:=ROUND((Ak-An)/Da);
  for i:=0 to Na do
   begin
    a:=An+Da*i;
    for j:=0 to Nx do
     begin
      x:=Xn+Dx*j;
      Writeln('x=',x:3:1,'    a=',a:3:1,'    f=',f(x,a):0:5);
     end;
   end;
  Readln;
END.

Добавлено (18.12.11, 17:32)
---------------------------------------------
А нужно, чтобы было вот как в этом примере (Только в нем решается не интеграл, а уравнение):
[CODE]Program TabRgr
const Nmax = 20
type
Tmy=array[1..Nmax,1..Nmax] of Extended;
Tmx=array[1..Nmax] of Extended;
Ter=array[1..Nmax,1..Nmax] of integer;
var
A,Mx:Tmx;
My: Tmy;
Xn,Xk,Dx,B,C,D,Xo,Eps,Z,Zt:Extended;
I,J,K,N,Err,Km:integer;
Er:Ter;
{Текст процедуры ввода массива}
Procedure DataIn(N: Integer;var A:Tmx);
var
I:integer
begin
for I:=1 to N do
read(A[I]);
end;
{Текст процедуры табулирования}
Procedure Tab(B,Xn,Xk,Dx:Extended; N:Integer; var Er:Ter;
var A,Mx:Tmx; Var My:Tmy};
var
I,J:Integer;
X,Y:Extended
begin
for J:=1 to N do
begin
I:=1;
X:=Xn;
Er[J,I]:=0
repeat
if X<2 then
Y:=B*sqr(sin(A[j]*X))
else if (A[j]*X+B)>0 then
Y:=X*sqrt(A[J]*X+B)
else Er[J,I]:=1;
Mx[I]:=X; My[J,I]:=Y;
Inc(I);
X:=X+Dx;
until X>Xk
end;
end;
{Текст подпрограммы-функции}
Function F(C,D,X:Extended):Extended;
begin
F:=C*sin(X)+X-D;
end;
{тут программа решения нелинейного уравнения}

Добавлено (18.12.11, 17:34)
---------------------------------------------
На продолжение места не хватает)

Добавлено (18.12.11, 17:37)
---------------------------------------------

Code
{Текст процедуры вывода данных}
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 N do {Вывод результатов выполнения программы}
      begin
         writeIn('A[',J,']=',A[J]:8:4);
          writeIn('X',  'Y');
           for I:=1 to K do
            if Er[J,I]=1 then
             writeIn(Mx[I]:6:3, ' ошибка данных')
            else
             writeIn(Mx[I]:6:3,'   ',My[J,I]:6:3);
      end;
   end;

Добавлено (18.12.11, 17:38)
---------------------------------------------

Code
begin {Начало главной програмы}
  writeIn('Введите значение переменных:Xn,Xk,Dx,N');
  readIn(Xn,Xk,Dx,N);
writeIn('Xn=',Xn:4:2,' Xk=', Xk:4:2,' Dx=', Dx:4:2,' N=', N);
writeIn('Введите значения: параметров уравнения C,D; начального',
' приближения Xo, погрешности Eps, предельного числа циклов Km');
readIn(C,D,Xo,Eps,Km);
writeIn('C=',C:6:3, ' D=',D:6:3, ' Xo=',Xo:7:3, ' Eps=',Eps:7:5, ' Km=',Km:3);
   writeIn('Введите массив из N элементов');
    DataIn(N,A);    {Вызов подпрограммы ввода массива}
     Equat(Xo,Eps,Km,Err,Z); {Вызов подпрограммы  нахождения корня уравнения}
     if Err = 1 then
    begin
      writeIn('Корень не найден за', Km:2,' итераций');
      exit
     end;
    Zt:= F(C,D,Z);     {Погрешность вычисления корня по невязке}
    B:=Z;
   writeIn('Корень равен B=', B:4:2, ' Zt=', Zt:8:7);
  Tab(B,Xn,Xk,Dx,N,Er,A,Mx,My);    {Вызов подпрограммы табулирования}
  K:= trunc((Xk-Xn)/Dx+1);
ResOut(Mx,A,My,Er,K);                {Вызов подпрограммы вывода данных}     
readln;
end.

буду очень благодарен.
1 | Автор: Rume | 2011-12-18, 17:38   |  Репутация: [ + 0 ]
  • Страница 1 из 1
  • 1
Поиск: