Приветствую Вас Гость 23:55 | 28.11.2024
  • Страница 1 из 1
  • 1
Модуль
Cruzel
Понедельник, 21.11.2011, 08:58 | Сообщение # 1
Удаленные
Сообщений:
Code
{$N+}
{ Math.pas "ABASE2" }

unit Math;

interface

type
      Float = Real;
      TIntegralFunc = function( X : float ) : float;

var  Ln10 : float;

function Integral( A, B, Accuracy : float; Fx : TIntegralFunc ) : float;
function Lg( X : float ) : float;
function Log( a, X : float) : float;
function SqrN( X, n : float ) : float;
function SqrtN( X, n : float ) : float;
function ArcSin( X : float ) : float;
function ArcCos( X : float ) : float;
function ArcCtg( X : float ) : float;

implementation

{Simpson Integral}
function Integral( A, B, Accuracy : float; Fx : TIntegralFunc ) : float;
{const Accur = 0.0000000001;}
{incorrect 0.000000000000000000001}
const MinAccur : float = 0.00000000000000000001;
var T, BA, F, Fold, C, p1, p2 : float;
begin
case SizeOf(Float) of
  6: MinAccur:=0.00000000001;
  4: MinAccur:=0.0000001;
  8: MinAccur:=0.000000000000001;
10: MinAccur:=0.0000000000000000001;
end;
Accuracy:=abs(Accuracy);
if Accuracy<MinAccur then Accuracy:=MinAccur;

T := sqr(15*Accuracy);
BA := B - A;
p1 := Fx(B) + Fx(A);

repeat
  BA := BA / 2;
  p2 := BA + A;
  C := 0;

  repeat
   C := Fx(p2)*2 + C;
   p2 := BA*2 + p2;
  until p2-B>=0;

  p1 := p1 + C;
  Fold := F;
  F := ((p1 + C) / 3)*BA;
until sqr(Fold-F)-T<0;

Integral:=F;
end;

function Log( a, X : float) : float;
begin
Log := Ln(X) / Ln(a);
end;

function Lg( X : float ) : float;
{Ln10=0.43429448}
begin
Lg := Ln10*Ln(X);
end;

function SqrN( X, n : float ) : float;
begin
SqrN := Exp( n*Ln(X) );
end;

function SqrtN( X, n : float ) : float;
begin
SqrtN := Exp( Ln(X) / n );
end;

function Sign( X : float ): float;
begin
if X=0 then Sign:=1
    else Sign:=X/abs(X);
end;

function ArcSin( X : float ) : float;
var y,s : float;
begin
y:=1 - X*X;
y:=abs(y);
s:=sign(X);
if y=0 then ArcSin:=s*PI/2
    else ArcSin := ArcTan( X / Sqrt(y) );
end;

function ArcCos( X : float ) : float;
var y,s : float;
begin
y:=1 - X*X;
y:=abs(y);
s:=sign(X);
if X=0 then
    ArcCos:=PI/2
    else ArcCos := ArcTan ( Sqrt(y) / X );
end;

function ArcCtg( X : float ) : float;
begin
ArcCtg := PI / 2 - ArcTan(X);
end;

begin
Ln10 := 1/Ln(10);
end.


программа с модулем
Code

uses Math;

function ifunc(x:float):float; far;
begin
ifunc:=sqrt(2*x+1); {where x: 0..1, f(x[0..1])=1.3987174742}
end;

function ifunc2(x:float):float; far;
begin
ifunc2:=(x*x*x)/(x*x*x*x+16); {where x: 0..1, f(x[1..5])=0.9074539}
end;

begin
writeln('PI/4',PI/4);
writeln(arcsin(1));
writeln(1/exp(1.0));
writeln('Must be =  ',1.3987174742:1:10);
writeln('Calculate  ',Integral(0,1,0,ifunc):1:10);
{writeln('Calculate  ',Integral(0,1,0.00000000000000000001,ifunc):1:10);}
writeln('Calculate2 ',Integral(1,5,0.0001,ifunc2):1:10);
end.


ещё
Code

{$N+}
uses Math, crt;

function ifunc(x:float):float; far;
begin
ifunc:=sqrt(2*x+1); {where x: 0..1, f(x[0..1])=1.3987174742}
end;

function ifunc2(x:float):float; far;
begin
ifunc2:=(x*x*x)/(x*x*x*x+16); {where x: 0..1, f(x[1..5])=0.9074539}
end;

function ifunc3(x:float):float; far;
begin
ifunc3:=sin(x);
end;

function ifunc4(x:float):float; far;
begin
ifunc4:=sin(x)/cos(x);
end;

var g : float;

begin
clrscr;
g:=1;
repeat
  writeln('Angle= ',g:3:0,
          ' Arcctg=',(Arcctg(cos(PI*g/180)/Sin(PI*g/180))*180/PI):2:4);
  g:=g+90;
until g>360;
halt;
g:=0;
repeat
  writeln('Angle= ',g:3:0,
          ' ArcSin=',(ArcSin(Sin(PI*g/180))*180/PI):2:4,
          ' ArcCos=',(ArcCos(Cos(PI*g/180))*180/PI):2:4);
  g:=g+90;
until g>360;
writeln;writeln;
g:=0;
repeat
  writeln('Angle= ',g:3:0,
          ' ArcSin=',(ArcSin(Sin(PI*g/180))*180/PI):2:4,
          ' ArcCos=',(ArcCos(Cos(PI*g/180))*180/PI):2:4);
  g:=g-90;
until abs(g)>360;
g:=180;
writeln('Angle= ',g:3:0,
         ' ArcCos=',(ArcCos(Cos(PI*g/180))*180/PI):2:4);
g:=270;
writeln('Angle= ',g:3:0,
         ' ArcCos=',(ArcCos(Cos(PI*g/180))*180/PI):2:4);
g:=-90;
writeln('Angle= ',g:3:0,
         ' ArcCos=',(ArcCos(Cos(PI*g/180))*180/PI):2:4);
halt;

writeln(SqrtN(64,2));
writeln(SqrN(2,8));
writeln(Lg(100));

writeln('PI/4',PI/4);
writeln(arcsin(1));
writeln(1/exp(1.0));
writeln('Must be =  ',1.3987174742:1:10);
writeln('Calculate  ',Integral(0,1,0,ifunc):1:10);
{writeln('Calculate  ',Integral(0,1,0.00000000000000000001,ifunc):1:10);}
writeln('Calculate2 ',Integral(1,5,0.0001,ifunc2):1:10);
writeln('Calculate3 ',Integral(0,1,0.00000001,ifunc3):1:10);
writeln('Calculate4 ',Integral(0,1,0.00000001,ifunc4):1:10);
end.
  • Страница 1 из 1
  • 1
Поиск:
пусто
Copyright © 2011 WarCrafting Portal