Uses CRt; CONST minX = 59.0; maxX = 62.0; LenX = maxX-minX; Eps : real = 0.00001; {---------------------------------------------------------------} VAR Value : real; Ntr : longint; {---------------------------------------------------------------} Function F_X(X:real):real; begin { F_X := sqrt(X)*(x);} { F_X := sqrt(40000-x*x);} F_X := sin(49*x*PI/180)*cos(12.5*x*PI/180)+1; { F_X := sin(X)*cos(X*PI/180)+1;} { F_X := 1/x+1;} end;{F_X} {---------------------------------------------------------------} Procedure LeftPram; var LastVal : real; i : longint; y : real; begin Ntr := 1; repeat LastVal := Value; Value := 0; for i := 0 to Ntr-1 do begin y := F_X(lenX*i/Ntr + minX); Value := Value + y*lenX/Ntr; end; Ntr:=Ntr shl 1; until abs(Value-LastVal) < Eps; end;{LeftPram} {--------------------------------------------------------------} Procedure CenterPram; var LastVal : real; i : longint; y : real; begin Ntr := 1; repeat LastVal := Value; Value := 0; for i := 0 to Ntr-1 do begin y := F_X(lenX*i/Ntr + minX + lenX/Ntr/2); Value := Value + y*lenX/Ntr; end; Ntr:=Ntr shl 1; until abs(Value-LastVal) < Eps; end;{CenterPram} {--------------------------------------------------------------} Procedure RightPram; var LastVal : real; i : longint; y : real; begin Ntr := 1; repeat LastVal := Value; Value := 0; for i := 1 to Ntr do begin y := F_X(lenX*i/Ntr + minX); Value := Value + y*lenX/Ntr; end; Ntr:=Ntr shl 1; until abs(Value-LastVal) < Eps; end;{RightPram} {--------------------------------------------------------------} Procedure CalcTrap; var LastVal : real; i : longint; y1,y2 : real; begin Ntr := 1; repeat LastVal := Value; Value := 0; for i := 1 to Ntr do begin y1 := F_X((lenX*(i-1))/Ntr + minX); y2 := F_X( lenX* i /Ntr + minX); Value := Value + ((y1+y2)/2)*(lenX/Ntr); end; Ntr:=Ntr shl 1; until abs(Value-LastVal) < Eps; end;{CalcTrap} {--------------------------------------------------------------} VAR mode : byte; BEGIN mode:=0; WriteLn('Выберите метод интегрирования:'); WriteLn(' 1: Левосторонних прямоугольников'); WriteLn(' 2: Центральных прямоугольников'); WriteLn(' 3: Правосторонних прямоугольноков'); WriteLn(' 4: Метод трапеций'); Write(#13'Нажмите: '); while not (mode in [1..4]) do Mode:=Ord(ReadKey)-$30; Write(Mode); case mode of 1: LeftPram; 2: CenterPram; 3: RightPram; 4: CalcTrap; end; WriteLn(#10#13'Интергал: ',Value:0:5); END.