関数

 投稿者：しばっち  投稿日：2011年11月13日(日)20時12分37秒
  関数をいくつか定義してみました(※エラー処理なし)

EXTERNAL FUNCTION SEC(X)
LET SEC=1/COS(X) !'secant
END FUNCTION

EXTERNAL FUNCTION COSEC(X)
LET COSEC=1/SIN(X) !'cosecant
END FUNCTION

EXTERNAL FUNCTION COTAN(X)
LET COTAN=1/TAN(X) !'cotangent
END FUNCTION

EXTERNAL FUNCTION ARCSIN(X)
LET ARCSIN=ATN(X/SQR(1-X*X)) !'arcsine
END FUNCTION

EXTERNAL FUNCTION ARCCOS(X)
LET ARCCOS=-ATN(X/SQR(1-X*X))+PI/2 !'arccosine
END FUNCTION

EXTERNAL FUNCTION ARCSEC(X)
LET ARCSEC=ATN(SQR(X*X-1))+(SGN(X)-1)*PI/2 !'arcsecant
END FUNCTION

EXTERNAL FUNCTION ARCSEC2(X)
LET ARCSEC2=ACOS(1/X)
END FUNCTION

EXTERNAL FUNCTION ARCCOSEC(X)
LET ARCCOSEC=ATN(1/SQR(X*X-1))+(SGN(X)-1)*PI/2 !'arccosecant
END FUNCTION

EXTERNAL FUNCTION ARCCOSEC2(X)
LET ARCCOSEC2=ASIN(1/X)
END FUNCTION

EXTERNAL FUNCTION ARCCOTAN(X)
LET ARCCOTAN=-ATN(X)+PI/2 !'arccotangent
END FUNCTION

EXTERNAL FUNCTION ARCCOTAN2(X)
LET ARCCOTAN=ATN(1/X)
END FUNCTION

EXTERNAL FUNCTION SINH(X)
LET SINH=(EXP(X)-EXP(-X))/2 !'hyperbolic sine
END FUNCTION

EXTERNAL FUNCTION COSH(X)
LET COSH=(EXP(X)+EXP(-X))/2 !'hyperbolic cosine
END FUNCTION

EXTERNAL FUNCTION TANH(X)
LET TANH=-EXP(-X)/(EXP(X)+EXP(-X))*2+1 !'hyperbolic tangent
END FUNCTION

EXTERNAL FUNCTION TANH2(X)
LET TANH2=SINH(X)/COSH(X)
END FUNCTION

EXTERNAL FUNCTION SECH(X)
LET SECH=2/(EXP(X)+EXP(-X)) !'hyperbolic secant
END FUNCTION

EXTERNAL FUNCTION SECH2(X)
LET SECH2=1/COSH(X)
END FUNCTION

EXTERNAL FUNCTION COSECH(X)
LET COSECH =2/(EXP(X)-EXP(-X)) !'hyperbolic cosecant
END FUNCTION

EXTERNAL FUNCTION COSECH2(X)
LET COSECH2=1/SINH(X)
END FUNCTION

EXTERNAL FUNCTION COTANH(X)
LET COTANH=EXP(-X)/(EXP(X)-EXP(-X))*2+1 !'hyperbolic cotangent
END FUNCTION

EXTERNAL FUNCTION COTANH2(X)
LET COTANH2=1/TANH(X)
END FUNCTION

EXTERNAL FUNCTION ARCSINH(X)
LET ARCSINH=LOG(X+SQR(X*X+1)) !'arc-hyperbolic sine
END FUNCTION

EXTERNAL FUNCTION ARCCOSH(X)
LET ARCCOSH=LOG(X+SQR(X*X-1)) !'arc-hyperbolic cosine
END FUNCTION

EXTERNAL FUNCTION ARCTANH(X)
LET ARCTANH=LOG((1+X)/(1-X))/2 !'arc-hyperbolic tangent
END FUNCTION

EXTERNAL FUNCTION ARCSECH(X)
LET ARCSECH=LOG((SQR(1-X*X)+1)/X) !'arc-hyperbolic secant
END FUNCTION

EXTERNAL FUNCTION ARCCOSECH(X)
LET ARCCOSECH=LOG((SGN(X)*SQR(X*X+1)+1)/X) !'arc-hyperbolic cosecant
END FUNCTION

EXTERNAL FUNCTION ARCCOTANH(X)
LET ARCCOTANH=LOG((X+1)/(X-1))/2 !'arc-hyperbolic cotangent
END FUNCTION

EXTERNAL FUNCTION SINC(X)
IF X=0 THEN LET  SINC=1 ELSE LET  SINC=SIN(X)/X
END FUNCTION

EXTERNAL FUNCTION SUM(X)
LET SUM=X/2*(X+1) !'1 + 2 + 3  +...+ X
END FUNCTION

EXTERNAL FUNCTION FACT2(A) !'n!!
IF MOD(A,2)=0 THEN
   LET FACT2=2^(A/2)*FACT(A/2) !'2*4*6*8*...
ELSE
   LET FACT2=FACT(A)/((2^((A-1)/2))*(FACT((A-1)/2)))  !'3*5*7*...
END IF
END FUNCTION

EXTERNAL FUNCTION H(N,R)
LET H=COMB(N+R-1,R) !'nHr 重複組合わせ
END FUNCTION

EXTERNAL FUNCTION ATN2(Y,X)
LET ATN2=ASIN(Y/SQR(X*X+Y*Y)) !' X=SQR(X^2+Y^2)*COS(θ) Y=SQR(X^2+Y^2)*SIN(θ)
END FUNCTION

EXTERNAL FUNCTION MAX(X,Y)
LET MAX=(X+Y+ABS(X-Y))/2 !'IF X>Y THEN MAX=X ELSE MAX=Y 最大値
END FUNCTION

EXTERNAL FUNCTION MIN(X,Y)
LET MIN=(X+Y-ABS(X-Y))/2 !'IF X<Y THEN MIN=X ELSE MIN=Y 最小値
END FUNCTION

EXTERNAL FUNCTION SQR2(X,Y)
LET SQR2=X/COS(ATN(Y/X)) !'SQR(X*X+Y*Y) X>Y
END FUNCTION

EXTERNAL FUNCTION MOD2(X,Y)
LET MOD2=X-INT(X/Y)*Y !'X MOD Y 余り
END FUNCTION

EXTERNAL FUNCTION FIX(X)
LET FIX=INT(ABS(X))*SGN(X) !'FIX(X) 整数部
END FUNCTION

EXTERNAL FUNCTION FRAC(X)
LET FRAC=X-FIX(X) !'FRAC(X) 小数部
END FUNCTION

EXTERNAL FUNCTION FLOOR(X)
IF INT(X)>X THEN LET FLOOR=INT(X)-1 ELSE LET FLOOR=INT(X) !'floor(x)
END FUNCTION

EXTERNAL FUNCTION CEIL(X)
IF INT(X)<X THEN LET CEIL=INT(X)+1 ELSE LET CEIL=INT(X) !'ceil(x)
END FUNCTION

EXTERNAL FUNCTION MIDDLE(X,A,B) !' A<=X<=B
LET MIDDLE=MAX(A,MIN(X,B))
END FUNCTION

EXTERNAL FUNCTION ZELLER(Y,M,D)
LET ZELLER=MOD(Y+INT(Y/4)-INT(Y/100)+INT(Y/400)+INT((13*M+8)/5)+D,7) !'ツェラーの公式
END FUNCTION

EXTERNAL FUNCTION WEEK(Y,M,D)
IF M<3 THEN
   LET YY=Y-1
   LET MM=M+12
ELSE
   LET YY=Y
   LET MM=M
END IF
LET WEEK=ZELLER(YY,MM,D)
END FUNCTION

EXTERNAL FUNCTION DAY$(Y,M,D) !'曜日を求める
LET DAY$=MID$("日月火水木金土",WEEK(Y,M,D)+1,1) & "曜日"
END FUNCTION

EXTERNAL FUNCTION NORMAL(U,M,X) !'正規分布密度関数
LET NORMAL=EXP(-(X-U)*(X-U)/(2*M*M))/SQR(2*PI)/M
END FUNCTION

EXTERNAL FUNCTION FUN(X)
LET FUN=1/X !'ダミー定義
END FUNCTION

EXTERNAL FUNCTION FUN2(X,Y)
LET FUN2=X^3+X*Y^2-X^2+X*Y+X !'ダミー定義
END FUNCTION

EXTERNAL FUNCTION FX(X,Y,H)
LET FX=(FUN2(X+H,Y)-FUN2(X,Y))/H !'d/dxF(X,Y)
END FUNCTION

EXTERNAL FUNCTION FY(X,Y,H)
LET FY=(FUN2(X,Y+H)-FUN2(X,Y))/H !'d/dyF(X,Y)
END FUNCTION

EXTERNAL FUNCTION F3(X,H)
LET F3=(FUN(X+H)-FUN(X-H))/(2*H) !'３点微分
END FUNCTION

EXTERNAL FUNCTION F5(X,H)
LET F5 =(-FUN(X+2*H)+8*FUN(X+H)-8*FUN(X-H)+FUN(X-2*H))/(12*H) !'５点微分
END FUNCTION

EXTERNAL FUNCTION FF3(X,H)
LET FF3=(FUN(X+H)-2*FUN(X)+FUN(X-H))/(H*H) !'２階３点微分
END FUNCTION

EXTERNAL FUNCTION FF5(X,H)
LET FF5=(-FUN(X-2*H)+16*FUN(X-H)-30*FUN(X)+16*FUN(X+H)-FUN(X+2*H))/(12*H*H) !'２階５点微分
END FUNCTION

EXTERNAL FUNCTION FFF5(X,H)
LET FFF5=(-FUN(X-2*H)+2*FUN(X-H)-2*FUN(X+H)+FUN(X+2*H))/(2*H*H*H) !'３階５点微分
END FUNCTION

EXTERNAL  FUNCTION FXN(XX,H,N) !'n階微分
IF N=0 THEN
   LET  FXN=FUN(XX)
ELSE
   LET FXN=(-FXN(XX+2*H,H,N-1)+8*FXN(XX+H,H,N-1)-8*FXN(XX-H,H,N-1)+FXN(XX-2*H,H,N-1))/(12*H) !'d^n/dx^nF(X)
END IF
END FUNCTION
 		 

Re: 関数

 投稿者：しばっち  投稿日：2011年11月13日(日)20時13分30秒
  > No.1717[元記事へ]

続き


EXTERNAL FUNCTION STIRLING(N)
LET STIRLING=SQR(N*2*PI)*N^N*EXP(-N) !'FACT(N)
END FUNCTION

EXTERNAL FUNCTION AREA3(X1,Y1,X2,Y2,X3,Y3)
LET AREA3=ABS(X1*Y2+X2*Y3+X3*Y1-Y1*X2-Y2*X3-Y3*X1)/2 !'三角形の面積
END FUNCTION

EXTERNAL FUNCTION AREA(N, X(), Y()) !'n角形の面積
LET  A = X(N - 1) * Y(1) - X(1) * Y(N - 1)
FOR I = 2 TO N - 1
   LET  A = A + X(I - 1) * Y(I) - X(I) * Y(I - 1)
NEXT I
LET  AREA = ABS(A) / 2
END FUNCTION

EXTERNAL FUNCTION NINT(X,N)
LET NINT=INT(10^N*X+.5)/10^N
END FUNCTION

EXTERNAL FUNCTION ISLOWER(X$)
IF ORD(X$)>=97 AND ORD(X$)<=122 THEN LET ISLOWER=-1 ELSE LET ISLOWER=0 !'小文字なら真
END FUNCTION

EXTERNAL FUNCTION ISUPPER(X$)
IF ORD(X$)>=65 AND ORD(X$)<=90 THEN LET ISUPPER=-1 ELSE LET ISUPPER=0 !'大文字なら真
END FUNCTION

EXTERNAL FUNCTION ISDIGIT(X$)
IF ORD(X$)>=48 AND ORD(X$)<=57 THEN LET ISDIGIT=-1 ELSE LET ISDIGIT=0 !'数字なら真
END FUNCTION

EXTERNAL FUNCTION ISALNUM(X$)
IF ISLOWER(X$)=-1 OR ISUPPER(X$)=-1 OR ISDIGIT(X$)=-1 THEN LET ISALNUM=-1 ELSE LET ISALNUM=0
END FUNCTION

EXTERNAL FUNCTION ISALPHA(X$)
IF ISLOWER(X$)=-1 OR ISUPPER(X$)=-1 THEN LET ISALPHA=-1 ELSE LET ISALPHA=0
END FUNCTION

EXTERNAL FUNCTION ISGRAPH(X$)
IF ORD(X$)>=33 AND ORD(X$)<=126 THEN LET ISGRAPH=-1 ELSE LET ISGRAPH=0 !'印字可能文字なら真（空白除く）
END FUNCTION

EXTERNAL FUNCTION ISCNTRL(X$)
IF ORD(X$)<=31 OR ORD(X$)=127 THEN LET ISCNTRL=-1 ELSE LET ISCNTRL=0 !'制御文字なら真
END FUNCTION

EXTERNAL FUNCTION ISPRINT(X$)
IF ORD(X$)>=32 AND ORD(X$)<=126 THEN LET ISPRINT=-1 ELSE LET ISPRINT=0 !'印字可能文字なら真
END FUNCTION

EXTERNAL FUNCTION ISSPACE(X$)
IF ORD(X$)>=9 AND ORD(X$)<=13 OR ORD(X$)=32 THEN LET ISSPACE=-1 ELSE LET ISSPACE=0 !'空白、タブ、復帰、改項、垂直タブ、改頁なら真
END FUNCTION

EXTERNAL FUNCTION ISHEXDIGIT(X$)
IF ISDIGIT(X$)=-1 OR ORD(X$)>=65 AND ORD(X$)<=70 OR ORD(X$)>=97 AND ORD(X$)<=102 THEN LET ISHEXDIGIT=-1 ELSE LET ISHEXDIGIT=0 !'１６進表示文字なら真
END FUNCTION

EXTERNAL FUNCTION ISPUNCT(X$)
IF ORD(X$)>=33 AND ORD(X$)<=47 OR ORD(X$)>=58 AND ORD(X$)<=64 OR ORD(X$)>=91 AND ORD(X$)<=96 OR ORD(X$)>=123 AND ORD(X$)<=126 THEN LET ISPUNCT=-1 ELSE LET ISPUNCT=0 !'区切り文字なら真
END FUNCTION

EXTERNAL FUNCTION ISKANJI(X$)
IF LEN(X$)<>BLEN(X$) THEN LET  ISKANJI=-1 ELSE LET  ISKANJI=0 !'2バイト文字なら真
END FUNCTION

EXTERNAL FUNCTION FIB(N)
LET FIB=INT((((1+SQR(5))/2)^N)/SQR(5)+.5) !'フィボナッチ数列
END FUNCTION

EXTERNAL FUNCTION FIB2(N)
LET A =1
LET B =1
FOR I=1 TO N-2
   LET A=A+B
   LET B=A-B
NEXT I
LET FIB2=A
END FUNCTION

EXTERNAL FUNCTION MOVEX(X,N,S) !'テンキーによるキャラクター移動(X方向)
IF S=1 OR S=4 OR S=7 THEN LET MOVEX=X+N
IF S=3 OR S=6 OR S=9 THEN LET MOVEX=X-N
END FUNCTION

EXTERNAL FUNCTION MOVEY(Y,N,S) !'テンキーによるキャラクター移動(Y方向)
IF S=7 OR S=8 OR S=9 THEN LET MOVEY=Y-N
IF S=1 OR S=2 OR S=3 THEN LET MOVEY=Y+N
END FUNCTION

EXTERNAL FUNCTION MOVEX2(X,N,S)
LET MOVEX2=X+N*(MOD((S-1),3)-1)
END FUNCTION

EXTERNAL FUNCTION MOVEY2(Y,N,S)
LET MOVEY2=Y+N*(INT((1-S)/3)+1)
END FUNCTION

EXTERNAL FUNCTION LAGRANGE2(X0,X1,Y0,Y1,T)
LET LAGRANGE2=Y0*(T-X1)/(X0-X1)+Y1*(T-X0)/(X1-X0) !'ラグランジュ補間
END FUNCTION

EXTERNAL FUNCTION LAGRANGE3(X0,X1,X2,Y0,Y1,Y2,T)
LET LAGRANGE3=((X2-T)*LAGRANGE2(X0,X1,Y0,Y1,T)-(X1-T)*LAGRANGE2(X0,X2,Y0,Y2,T))/(X2-X1)
END FUNCTION

EXTERNAL FUNCTION LAGRANGE4(X0,X1,X2,X3,Y0,Y1,Y2,Y3,T)
LET LAGRANGE4=((X3-T)*LAGRANGE3(X0,X1,X2,Y0,Y1,Y2,T)-(X2-T)*LAGRANGE3(X0,X1,X3,Y0,Y1,Y3,T))/(X3-X2)
END FUNCTION

EXTERNAL FUNCTION LAGRANGE5(X0,X1,X2,X3,X4,Y0,Y1,Y2,Y3,Y4,T)
LET LAGRANGE5=((X4-T)*LAGRANGE4(X0,X1,X2,X3,Y0,Y1,Y2,Y3,T)-(X3-T)*LAGRANGE4(X0,X1,X2,X4,Y0,Y1,Y2,Y4,T))/(X4-X3)
END FUNCTION

EXTERNAL  FUNCTION LAGRANGE(N, X(), Y(), T)
FOR I = 1 TO N
   LET  P = Y(I)
   FOR J = 1 TO N
      IF I <> J THEN LET  P = P * (T - X(J)) / (X(I) - X(J)) !'ラグランジュ補間
   NEXT J
   LET  S = S + P
NEXT I
LET  LARGRANGE = S
END FUNCTION

EXTERNAL FUNCTION Y3(X,X0,Y0,X1,Y1,X2,Y2)
LET Y3=((X-X1)*(X-X2))/((X0-X1)*(X0-X2))*Y0+((X-X0)*(X-X2))/((X1-X0)*(X1-X2))*Y1+((X-X0)*(X-X1))/((X2-X0)*(X2-X1))*Y2 !'３点を通る２次方程式
END FUNCTION

EXTERNAL FUNCTION EQV(X,Y)
LET EQV=BITNOT(BITXOR(X,Y)) !'X EQV Y
END FUNCTION

EXTERNAL FUNCTION AND2(X,Y)
LET AND2=BITNOT(BITOR(BITNOT(X),BITNOT(Y))) !'X AND Y
END FUNCTION

EXTERNAL FUNCTION OR2(X,Y)
LET OR2=BITNOT(BITAND(BITNOT(X),BITNOT(Y))) !'X OR Y
END FUNCTION

EXTERNAL FUNCTION NAND(X,Y)
LET NAND=BITNOT(BITAND(X,Y)) !'X NAND Y
END FUNCTION

EXTERNAL FUNCTION NAND2(X,Y)
LET NAND2=BITOR(BITNOT(X),BITNOT(Y))
END FUNCTION

EXTERNAL FUNCTION NOR(X,Y)
LET NOR=BITNOT(BITOR(X,Y)) !'X NOR Y
END FUNCTION

EXTERNAL FUNCTION NOR2(X,Y)
LET NOR2=BITAND(BITNOT(X),BITNOT(Y))
END FUNCTION

EXTERNAL FUNCTION XOR2(X,Y)
LET XOR2=BITNOT(BITOR(BITAND(X,Y),NOR(X,Y))) !'X XOR Y
END FUNCTION

EXTERNAL FUNCTION XOR3(X,Y)
LET  XOR3=BITOR(BITAND(BITNOT(X),Y),BITAND(X,BITNOT(Y)))
END FUNCTION

EXTERNAL FUNCTION XOR4(X,Y)
LET  XOR4=BITAND(BITOR(X,Y),BITOR(BITNOT(X),BITNOT(Y)))
END FUNCTION

EXTERNAL FUNCTION XOR5(X,Y)
LET  XOR5=NAND(NAND(X,BITNOT(Y)),NAND(BITNOT(X),Y))
END FUNCTION

EXTERNAL FUNCTION IMP(X,Y)
LET IMP=BITOR(BITNOT(X),Y) !'X IMP Y
END FUNCTION

EXTERNAL FUNCTION IMP2(X,Y)
LET IMP2=BITNOT(BITAND(BITNOT(Y),X))
END FUNCTION

EXTERNAL FUNCTION NIMP(X,Y)
LET NIMP=BITNOT(BITOR(BITNOT(X),Y)) !'X NIMP Y
END FUNCTION

EXTERNAL FUNCTION NIMP2(X,Y)
LET NIMP2=BITAND(BITNOT(Y),X)
END FUNCTION

EXTERNAL FUNCTION NIMP3(X,Y)
LET NIMP3=BITNOT(IMP(X,Y))
END FUNCTION

EXTERNAL  FUNCTION GCD(M,N) !'最大公約数
DO WHILE N <> 0
   LET  T = MOD(M , N)
   LET  M = N
   LET  N = T
LOOP
LET  GCD=M
END FUNCTION

EXTERNAL  FUNCTION LCM(A, B)
LET  LCM=A*B/GCD(A,B) !'最小公倍数
END FUNCTION

EXTERNAL  FUNCTION LCM3(A, B, C)
LET  LCM3=A*B*C/GCD(A,B)/GCD(B,C)/GCD(A,C)*GCD(A,GCD(B,C))
END FUNCTION

EXTERNAL  FUNCTION WHICH(N,X,Y)
IF N<>0 THEN LET  WHICH=X ELSE LET  WHICH=Y
END FUNCTION

EXTERNAL  FUNCTION COSINE(OX, OY, PX, PY, MX, MY)
LET  COSINE=((PX - OX) * (MX - OX) + (PY - OY) * (MY - OY)) / SQR((PX - OX) * (PX - OX) + (PY - OY) * (PY - OY)) / SQR((MX - OX) * (MX - OX) + (MY - OY) * (MY - OY))
END FUNCTION

EXTERNAL  FUNCTION COSINE3D(AX,AY,AZ,BX,BY,BZ)
LET  COSINE3D=(AX*BX+AY*BY+AZ*BZ)/SQR(AX^2+AY^2+AZ^2)/SQR(BX^2+BY^2+BZ^2)
END FUNCTION

EXTERNAL  FUNCTION NSTR$(Y,N) !'N進文字列
LET  X=Y
LET  B$=""
DO
   LET  A$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",MOD(X,N)+1,1)
   LET  B$=A$&B$
   LET  X=INT(X/N)
LOOP UNTIL X=0
LET  NSTR$=B$
END FUNCTION

EXTERNAL  FUNCTION ANGLE2(X,Y)
LET  ANGLE2=ASIN(Y/SQR(X*X+Y*Y))
END FUNCTION
 		 

戻る