Составить программу на языке Turbo Pascal 7.0 вычисления значения интеграла на интервале [a, b] для функции, заданной графически

[AZelensky]

Сообщение от Mad_Cat

Синус-тригонометрическая функция
Ваша же - функция,заданная графически состоит из 3-х функций

Тут тоже из 3 функций? Это похоже на мой вариант?

[AZelensky]

Сообщение от Mad_Cat

я ага, конечно, ессстесно только живу в Уфе, и мне уже поздновато учиться
А по поводу задачи - есть готовая! Welcome to Skype - продам

а в университетах сейчас МатАна нет что ли? или Вам про "интригалы" не расказывали

За сколько можешь, а то я не справлюсь я метематическим вычислением?

[Mad_Cat]

в скайп стучи

[AZelensky]

Сообщение от Mad_Cat

в скайп стучи

Добавился.

[AZelensky]

Вот, что у меня получилось после правки кода под свою задачу:

program KKP2_1_DUB3;

uses
  CRT;

var
  
  A, B, C, E, ABS_Integral: real;

procedure ENTER_DATA(var PR_1, PR_2, P_PAR, POGR_PRO: REAL);

begin
  
  ClrScr;
  
  Writeln('Программа для нахождения значения интеграла на определенном промежутке');
  
  Writeln;
  
  writeln('Введите границы интервала [A,B],причем (A<B),число C (0<C<1) и точность E (E>0): ');
  
  writeln;
  
  repeat
    
    begin
      
      writeln('Число C: '); readln(P_PAR);
      
      if not (P_PAR > 0) then
        
        writeln('C должно быть больше 0 !. Повторите ввод.')
      
      ELSE if not (P_PAR < 1) THEN
        
        WRITELN('C должно быть меньше 1!. Повторите ввод.');
      
    end;
    
  until ((P_PAR > 0) AND (P_PAR < 1));
  
  repeat
    
    begin
      
      writeln('Начало интервала A: '); readln(PR_1);
      
      writeln('Конец интервала B: '); readln(PR_2);
      
      if not (PR_1 < PR_2) then
        
        writeln('A должно быть меньше B !. Повторите ввод.');
      
    end;
    
  until (PR_1 < PR_2);
  
  repeat
    
    begin
      
      writeln('Точность E: '); readln(POGR_PRO);
      
      if not (POGR_PRO > 0) then
        
        writeln('E должно быть больше 0 !. Повторите ввод.');
      
    end;
    
  until (POGR_PRO > 0);
  
end;

function integration(var GR_1, GR_2, F_PAR, POGR_FUNC: REAL): real;

var
  
  INTEGRAL1, INTEGRAL2, X, H: REAL;
  
  N: INTEGER;
  
  READY: BOOLEAN;

begin
  
  integral1 := 0;
  
  integral2 := 0;
  
  n := 1;
  
  repeat
    
    N := N * 2;
    
    H := (GR_2 - GR_1) / N;
    
    X := GR_1;
    
    Integral2 := 0;
    
    repeat
      
      if x <= (-F_PAR) then
        
        integral2 := integral2 + ((1 / sqr(3)) * (ln(F_PAR) - F_PAR))
      
      ELSE if((-F_PAR < x) and (x <= F_PAR))
        
        THEN integral2 := integral2 + Sin(x)
      
      ELSE if (X > F_PAR) THEN
        
        Integral2 := integral2 + ln(F_PAR);
      
      X := X + H;
      
    until not (X <= B);
    
    READY := abs(integral1 - integral2) < POGR_FUNC;
    
    INTEGRAL1 := INTEGRAL2;
    
  until READY;
  
  INTEGRATION := INTEGRAL2;
  
end;

begin
  
  ENTER_DATA(A, B, C, E);
  
  ABS_Integral := INTEGRATION(A, B, C, E);
  
  Writeln;
  
  Writeln( 'Ответ: ');
  
  writeln('Интеграл на промежутке от ', A:0:2, ' до ', B:0:2, ' равен ');
  
  writeln(ABS_Integral:1:3, ' с точностью ', E:1:3);
  
  ReadKey;
  
end.

Правильно?

[Mad_Cat]

Правильно?
нет! функция не та!

[AZelensky]

Сообщение от Mad_Cat

Правильно?
нет! функция не та!

На рисунке три функции: первая - kx+b, вторая - sin(x), а третья - ln(x). Что тут не правильного? А формула шага и левых прямоугольников одна и та же. Ещё интеграл = площади трапеции. В данном случае сумме площадей прямоугольников, ограниченных данными функциями

[AZelensky]

Сообщение от Mad_Cat

Правильно?
нет! функция не та!

А вот так правильно?

{$N+}
function y(const a,b,x: double): double;
    begin
    if x<-pi/2 then y:=(x-a)/(pi/2+a) else if x<pi/2 then y:=sin(x) else y:=1;
    end;
 
var
a,b,h,e,ip,ic: double;
i,n: longint;
 
begin
writeln('a:');
readln(a);
writeln('b:');
readln(b);
writeln('точность:');
readln(e);
 
ic:=0;
n:=16;
h:=(b-a)/n;
for i:=0 to n-1 do ic:=ic+y(a,b,a+i*h);
ic:=ic*h;
 
repeat
ip:=ic;
ic:=0;
for i:=0 to n-1 do ic:=ic+y(a,b,a+i*h+h/2);
ic:=(ic*h+ip)/2;
n:=n*2;
h:=(b-a)/n;
until abs(ic-ip)<e;
writeln('результат=',ic:6:6);
readln;
end.

[Mad_Cat]

а третья - ln(x)

и хде ты там ее увидал ума не приложу