|
|
16元数の四則演算と関数をいくつか定義してみました。
PUBLIC NUMERIC MAXLEVEL
OPTION BASE 0
LET MAXLEVEL=50
DIM A(15),B(15),C(15)
MAT READ A
!'DATA 1,-1 ,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 !'2元数(複素数)
!'DATA 1,-1,-1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 !'4元数(クォータニオン)
DATA 1,-1,-1,-1,-1,-1,-1,-1, 0, 0, 0, 0, 0, 0, 0, 0 !'8元数(オクトニオン)
!'DATA 1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 !'16元数
MAT READ B
!'DATA 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
!'DATA 2, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 2, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0
!'DATA 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
PRINT "A = ";
CALL CPRINT(A)
PRINT "B = ";
CALL CPRINT(B)
CALL CADD(A,B,C)
PRINT "A + B = ";
CALL CPRINT(C)
CALL CSUB(A,B,C)
PRINT "A - B = ";
CALL CPRINT(C)
CALL CMUL(A,B,C)
PRINT "A * B = ";
CALL CPRINT(C)
CALL CMUL(B,A,C)
PRINT "B * A = ";
CALL CPRINT(C) !' A×B≠B×A
CALL CDIV(A,B,C)
PRINT "A / B = ";
CALL CPRINT(C)
CALL CPOWER(A,B,C)
PRINT "A ^ B=";
CALL CPRINT(C)
CALL CSIN(A,B)
PRINT "SIN(A)=";
CALL CPRINT(B)
CALL CCOS(A,B)
PRINT "COS(A)=";
CALL CPRINT(B)
CALL CTAN(A,B)
PRINT "TAN(A)=";
CALL CPRINT(B)
END
EXTERNAL SUB HORNER(X(),Y(),K())
MAT Y=ZER
LET Y(0)=K(MAXLEVEL)
FOR I=MAXLEVEL-1 TO 0 STEP -1
CALL CMUL2(Y,X)
LET Y(0)=Y(0)+K(I)
NEXT I
END SUB
EXTERNAL SUB SMUL(A(),N)
MAT A=(N)*A
END SUB
EXTERNAL SUB COPY(A(),B())
MAT A=B
END SUB
EXTERNAL SUB CMUL(A(),B(),C())
OPTION BASE 0
DIM T$(15,15)
MAT C=ZER
MAT READ T$
FOR I=0 TO 15
FOR J=0 TO 15
IF A(I)<>0 AND B(J)<>0 THEN
IF T$(I,J)="-0" THEN
LET C(0)=C(0)-A(I)*B(J)
ELSE
LET D=VAL(T$(I,J))
IF D>=0 THEN
LET C(D)=C(D)+A(I)*B(J)
ELSE
LET C(-D)=C(-D)-A(I)*B(J)
END IF
END IF
END IF
NEXT J
NEXT I
DATA 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 !'16元数乗積表 (ウィキペディアより)
DATA 1, -0, 3, -2, 5, -4, -7, 6, 9, -8,-11, 10,-13, 12, 15,-14
DATA 2, -3, -0, 1, 6, 7, -4, -5, 10, 11, -8, -9,-14,-15, 12, 13
DATA 3, 2, -1, -0, 7, -6, 5, -4, 11,-10, 9, -8,-15, 14,-13, 12
DATA 4, -5, -6, -7, -0, 1, 2, 3, 12, 13, 14, 15, -8, -9,-10,-11
DATA 5, 4, -7, 6, -1, -0, -3, 2, 13,-12, 15,-14, 9, -8, 11,-10
DATA 6, 7, 4, -5, -2, 3, -0, -1, 14,-15,-12, 13, 10,-11, -8, 9
DATA 7, -6, 5, 4, -3, -2, 1, -0, 15, 14,-13,-12, 11, 10, -9, -8
DATA 8, -9,-10,-11,-12,-13,-14,-15, -0, 1, 2, 3, 4, 5, 6, 7
DATA 9, 8,-11, 10,-13, 12, 15,-14, -1, -0, -3, 2, -5, 4, 7, -6
DATA 10, 11, 8, -9,-14,-15, 12, 13, -2, 3, -0, -1, -6, -7, 4, 5
DATA 11,-10, 9, 8,-15, 14,-13, 12, -3, -2, 1, -0, -7, 6, -5, 4
DATA 12, 13, 14, 15, 8, -9,-10,-11, -4, 5, 6, 7, -0, -1, -2, -3
DATA 13,-12, 15,-14, 9, 8, 11,-10, -5, -4, 7, -6, 1, -0, 3, -2
DATA 14,-15,-12, 13, 10,-11, 8, 9, -6, -7, -4, 5, 2, -3, -0, 1
DATA 15, 14,-13,-12, 11, 10, -9, 8, -7, 6, -5, -4, 3, 2, -1, -0
END SUB
EXTERNAL SUB CMUL2(A(),B())
OPTION BASE 0
DIM C(15)
CALL CMUL(A,B,C)
CALL COPY(A,C)
END SUB
EXTERNAL SUB CADD(A(),B(),C())
MAT C=A+B
END SUB
EXTERNAL SUB CSUB(A(),B(),C())
MAT C=A-B
END SUB
EXTERNAL SUB CDIV(A(),B(),C())
OPTION BASE 0
DIM BB(15),S(15)
CALL CCONJ(B,BB)
CALL CMUL(B,BB,S)
CALL CMUL(A,BB,C)
CALL SMUL(C,1/S(0))
END SUB
EXTERNAL SUB CCONJ(A(),B())
LET B(0)=A(0)
FOR I=1 TO 15
LET B(I)=-A(I)
NEXT I
END SUB
EXTERNAL SUB CPRINT(A())
FOR I=0 TO 15
IF A(I)<>0 THEN
IF A(I)<0 THEN
PRINT " - ";
ELSE
IF I>0 AND A(0)<>0 THEN PRINT " + ";
END IF
IF ABS(A(I))<>1 OR I=0 THEN PRINT STR$(ABS(A(I)));
IF I>0 THEN PRINT MID$("ijklmnopqrstuvw",I,1);
END IF
NEXT I
PRINT
END SUB
EXTERNAL SUB CSIN(X(),Y())
OPTION BASE 0
DIM V(MAXLEVEL)
CALL SINE(V)
CALL HORNER(X,Y,V)
END SUB
EXTERNAL SUB CCOS(X(),Y())
OPTION BASE 0
DIM V(MAXLEVEL)
CALL COSINE(V)
CALL HORNER(X,Y,V)
END SUB
EXTERNAL SUB CTAN(X(),Y())
OPTION BASE 0
DIM XX(15),YY(15)
CALL CSIN(X,XX)
CALL CCOS(X,YY)
CALL CDIV(XX,YY,Y)
END SUB
EXTERNAL SUB CEXP(X(),Y())
OPTION BASE 0
DIM V(MAXLEVEL)
CALL EXPON(V)
CALL HORNER(X,Y,V)
END SUB
EXTERNAL SUB CLOG(X(),Y())
OPTION BASE 0
DIM V(MAXLEVEL),A(15),B(15),C(15)
CALL LN(V)
CALL COPY(A,X)
CALL COPY(B,X)
LET A(0)=A(0)-1
LET B(0)=B(0)+1
CALL CDIV(A,B,C)
CALL HORNER(C,Y,V)
CALL SMUL(Y,2)
END SUB
EXTERNAL SUB CPOWER(X(),Y(),A())
OPTION BASE 0
DIM XX(15),YY(15)
CALL COPY(YY,Y)
CALL CLOG(X,XX)
CALL CMUL2(YY,XX)
CALL CEXP(YY,A)
END SUB
EXTERNAL SUB SINE(X())
!'SIN(X)
LET X(1)=1
LET T=1
FOR I=3 TO MAXLEVEL STEP 2
LET T=-T/(I-1)/I
LET X(I)=T
NEXT I
END SUB
EXTERNAL SUB COSINE(X())
!'COS(X)
LET X(0)=1
LET T=1
FOR I=2 TO MAXLEVEL STEP 2
LET T=-T/(I-1)/I
LET X(I)=T
NEXT I
END SUB
EXTERNAL SUB EXPON(X())
!'EXP(X)
LET X(0)=1
LET T=1
FOR I=1 TO MAXLEVEL
LET T=T/I
LET X(I)=T
NEXT I
END SUB
EXTERNAL SUB LN(X())
!'LOG((X-1)/(X+1))
FOR I=1 TO MAXLEVEL
IF MOD(I,2)=1 THEN LET X(I)=1/I
NEXT I
END SUB
|
|