|
|
> No.4451[元記事へ]
更に2次元(複素数 x+yi (i^2=-1))ではなく、4次元(Quaternion x+yi+zj+wk (i^2=j^2=k^2=-1))でも求めてみました。
但し、3D表示は敷居が高く、表示方法や仕様設定等が未定なので表示は2Dです。
4次元では平面が6つで、X-Y平面 , X-Z平面 , X-W平面 , Y-Z平面 , Y-W平面 , Z-W平面があります。
残った2軸にはスライドバーにより、(-1.5 <= a <= 1.5)(-1.5 <= b <=1.5) を代入して定数とした切断面を描画します。
計算にクォータニオン(4元数)を用い、ニュートン法にて方程式 x^3-1=0 を解きながら結果を描画しています。
(※X-Y平面で Z=0 , W=0とした時の切断面は複素数による一般的なものと同じになります)
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM XX(3),X(3),S$(5),ST(6)
LET XSIZE=800 !'画像サイズ
LET YSIZE=800
CALL GINIT(XSIZE,YSIZE)
MAT READ S$
LOCATE CHOICE(S$) : N
DATA "X-Y平面 Z=A,W=B"
DATA "X-Z平面 Y=A,W=B"
DATA "X-W平面 Y=A,Z=B"
DATA "Y-Z平面 X=A,W=B"
DATA "Y-W平面 X=A,Z=B"
DATA "Z-W平面 X=A,Y=B"
LOCATE VALUE(1) ,RANGE -1.5 TO 1.5 ,AT 0: A
LOCATE VALUE(2) ,RANGE -1.5 TO 1.5 ,AT 0: B
SELECT CASE N
CASE 1
PRINT "X-Y平面 Z=";A;", W=";B
CASE 2
PRINT "X-Z平面 Y=";A;", W=";B
CASE 3
PRINT "X-W平面 Y=";A;", Z=";B
CASE 4
PRINT "Y-Z平面 X=";A;", W=";B
CASE 5
PRINT "Y-W平面 X=";A;", Z=";B
CASE 6
PRINT "Z-W平面 X=";A;", Y=";B
END SELECT
LET LEFT=-1.5
LET RIGHT=1.5
LET BOTTOM=1.5
LET TOP=-1.5
LET KS=100
LET EPS=1E-5
SET WINDOW LEFT,RIGHT,BOTTOM,TOP
LET DX=(RIGHT-LEFT)/XSIZE
LET DY=(TOP-BOTTOM)/YSIZE
MAT READ ST
DATA 1,7,11,13,17,19,23
FOR I=6 TO 0 STEP -1
FOR ZR=LEFT TO RIGHT STEP DX*ST(I)
FOR ZI=BOTTOM TO TOP STEP DY*ST(I)
SELECT CASE N
CASE 1
CALL QSET(XX,ZR,ZI,A,B) !' X-Y平面 Z=A,W=B 切断面
CASE 2
CALL QSET(XX,ZR,A,ZI,B) !' X-Z平面 Y=A,W=B 切断面
CASE 3
CALL QSET(XX,ZR,A,B,ZI) !' X-W平面 Y=A,Z=B 切断面
CASE 4
CALL QSET(XX,A,ZR,ZI,B) !' Y-Z平面 X=A,W=B 切断面
CASE 5
CALL QSET(XX,A,ZR,B,ZI) !' Y-W平面 X=A,Z=B 切断面
CASE 6
CALL QSET(XX,A,B,ZR,ZI) !' Z-W平面 X=A,Y=B 切断面
END SELECT
FOR K=1 TO KS
MAT X=XX
CALL NEWTON(X,XX) !' xx=x-f(x)/f'(x) ニュートン法
IF QABS(XX,X)<EPS THEN !'収束判定
CALL PSET(ZR,ZI,MOD(K,7)+1)
EXIT FOR
END IF
NEXT K
NEXT ZI
NEXT ZR
NEXT I
END
EXTERNAL FUNCTION QABS(X(),Y())
OPTION ARITHMETIC NATIVE
FOR I=0 TO 3
LET A=A+(X(I)-Y(I))^2
NEXT I
LET QABS=SQR(A)
END FUNCTION
EXTERNAL SUB NEWTON (X(),XX())
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM A(3,3),Y1(3),Y2(3)
RESTORE
FOR I=3 TO 0 STEP -1
FOR J=0 TO 3
READ A(I,J)
NEXT J
NEXT I
DATA 1,0,0,0 !'(1+0i+0j+0k)*X^3
DATA 0,0,0,0 !'(0+0i+0j+0k)*X^2
DATA 0,0,0,0 !'(0+0i+0j+0k)*X
DATA -1,0,0,0 !'(-1+0i+0j+0k)
CALL HORNER(3,A,X,Y1) !' f(X)=X^3-1
CALL DERIVATIVE(3,A) !' 微分
CALL HORNER(2,A,X,Y2) !' f'(X)=3*X^2
CALL QDIV(Y1,Y2) !' (X^3-1)/(3*X^2)
MAT XX=X
CALL QSUB(XX,Y1) !' XX=X-(X^3-1)/(3*X^2)
END SUB
EXTERNAL SUB QSET(XX(),X,Y,Z,W)
OPTION ARITHMETIC NATIVE
LET XX(0)=X
LET XX(1)=Y
LET XX(2)=Z
LET XX(3)=W
END SUB
EXTERNAL SUB HORNER(N,A(,),X(),Y())
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM AA(3)
CALL QSET(Y,A(N,0),A(N,1),A(N,2),A(N,3))
FOR I=N-1 TO 0 STEP -1
CALL QMUL(Y,X) !'Y=Y*X
CALL QSET(AA,A(I,0),A(I,1),A(I,2),A(I,3))
CALL QADD(Y,AA) !' Y=Y+A
NEXT I
END SUB
EXTERNAL SUB QMUL(A(),B())
OPTION ARITHMETIC NATIVE
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 A=SS
END SUB
EXTERNAL SUB QDIV(A(),B())
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM BB(3)
CALL QINV(BB,B)
CALL QMUL(A,BB)
MAT A=(1/(B(0)^2+B(1)^2+B(2)^2+B(3)^2))*A
END SUB
EXTERNAL SUB QADD(A(),B())
OPTION ARITHMETIC NATIVE
MAT A=A+B
END SUB
EXTERNAL SUB QSUB(A(),B())
OPTION ARITHMETIC NATIVE
MAT A=A-B
END SUB
EXTERNAL SUB QINV(ZZ(),Z())
OPTION ARITHMETIC NATIVE
LET ZZ(0)=Z(0)
LET ZZ(1)=-Z(1)
LET ZZ(2)=-Z(2)
LET ZZ(3)=-Z(3)
END SUB
EXTERNAL SUB DERIVATIVE(N,A(,)) !'微分
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM B(N,3)
FOR I=N TO 1 STEP-1
FOR J=0 TO 3
LET B(I-1,J)=I*A(I,J)
NEXT J
NEXT I
FOR I=N TO 0 STEP -1
FOR J=0 TO 3
LET A(I,J)=B(I,J)
NEXT J
NEXT I
END SUB
EXTERNAL SUB PSET(X,Y,C)
OPTION ARITHMETIC NATIVE
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0
SET POINT STYLE 1
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
SET COLOR MIX(255) .5,.5,.5
CLEAR
END SUB
|
|
