|
|
素数を求める
!'ボクセル表現(VOXEL)
PUBLIC NUMERIC R
OPTION BASE 0
DIM A(3)
FILE GETSAVENAME F$,"dxfファイル|*.dxf"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".DXF")=0 THEN LET F$=F$ & ".dxf"
LET R=10 !'半径
OPEN #1:NAME F$
ERASE #1
PRINT #1:"0"
PRINT #1:"SECTION"
PRINT #1:"2"
PRINT #1:"ENTITIES"
FOR I=0 TO R
FOR J=0 TO R
FOR K=0 TO R
IF ABS(I)+ABS(J)+ABS(K)>1 AND SQR(I*I+J*J+K*K)<=R THEN
LET A(0)=I
LET A(1)=J
LET A(2)=K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=-I
LET A(1)=J
LET A(2)=K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=I
LET A(1)=-J
LET A(2)=K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=I
LET A(1)=J
LET A(2)=-K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=-I
LET A(1)=-J
LET A(2)=K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=-I
LET A(1)=J
LET A(2)=-K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=I
LET A(1)=-J
LET A(2)=-K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
LET A(0)=-I
LET A(1)=-J
LET A(2)=-K
IF ISQUATERNIONPRIME(A)<>0 THEN CALL CUBE(#1,A(0),A(1),A(2),1)
END IF
NEXT K
NEXT J
NEXT I
PRINT #1:"0"
PRINT #1:"ENDSEC"
PRINT #1:"0"
PRINT #1:"EOF"
CLOSE #1
END
EXTERNAL FUNCTION ISQUATERNIONPRIME(A())
OPTION BASE 0
DIM B(3),S(3)
LET ISQUATERNIONPRIME=0
FOR I=-R*1.5 TO R*1.5 !'探索範囲を広めに
FOR J=-R*1.5 TO R*1.5
FOR K=-R*1.5 TO R*1.5
IF SQR(I*I+J*J+K*K)<=R AND ABS(I)+ABS(J)+ABS(K)>1 THEN
LET B(0)=I
LET B(1)=J
LET B(2)=K
CALL DIV(S,A,B)
IF FRAC(S(0))=0 AND FRAC(S(1))=0 AND FRAC(S(2))=0 AND FRAC(S(3))=0 AND ABS(S(0))+ABS(S(1))+ABS(S(2))+ABS(S(3))>1 THEN
EXIT FUNCTION
END IF
END IF
NEXT K
NEXT J
NEXT I
LET ISQUATERNIONPRIME=-1
END FUNCTION
EXTERNAL FUNCTION FRAC(X) !'小数部
LET FRAC=X-INT(X)
END FUNCTION
EXTERNAL SUB MUL(S(),A(),B()) !'クォータニオン(4元数)掛算
OPTION BASE 0
DIM SS(3)
LET SS(0)=A(0)*B(0)-A(1)*B(1)-A(2)*B(2)-A(3)*B(3)
LET SS(1)=A(0)*B(1)+A(1)*B(0)+A(2)*B(3)-A(3)*B(2)
LET SS(2)=A(0)*B(2)-A(1)*B(3)+A(2)*B(0)+A(3)*B(1)
LET SS(3)=A(0)*B(3)+A(1)*B(2)-A(2)*B(1)+A(3)*B(0)
MAT S=SS
END SUB
EXTERNAL SUB DIV(S(),A(),B())
OPTION BASE 0
DIM BB(3)
LET BB(0)=B(0)
LET BB(1)=-B(1)
LET BB(2)=-B(2)
LET BB(3)=-B(3)
CALL MUL(S,A,BB)
MAT S=(1/(B(0)^2+B(1)^2+B(2)^2+B(3)^2))*S
END SUB
以下省略
EXTERNAL SUB CUBE(#1,X,Y,Z,L)
END SUB
|
|