フラクタル・ショー

! フラクタル・ショー
SET WINDOW -0.7,1.9,-1.1,1.5
SET TEXT FONT "Times New Roman",16

OPTION ARITHMETIC COMPLEX
DIM z0(2^16)
LET i=SQR(-1) ! 虚数を i にセット。
LET s=1

!----------
LET a=0
LET b=(3+SQR(3)*i)/6
LET r=0
LET d=2/3 ! 葉脈曲線
CALL Afine(14)

LET a=(1+i)/2
LET b=0
LET r=0
LET d=conj(a) ! カニの行列
CALL Afine(15)

LET a=(1+i)/2
LET b=0
LET r=0
LET d=-a ! ブロッコリー
CALL Afine(15)
WAIT DELAY 3

LET a=(1+i)/2
LET b=0
LET r=conj(a)
LET d=0 ! レヴィのＣ曲線
CALL Afine(15)
WAIT DELAY 2

LET a=(1+i)/2
LET b=0
LET r=a
LET d=0 ! ドラゴン
CALL Afine(15)
WAIT DELAY 2

LET a=0
LET b=1-EXP(-PI/5*i)
LET r=0
LET d=conj(b) ! クリヌキ正五角形
CALL Afine(14)
WAIT DELAY 1

LET a=0
LET b=(1+i)/2
LET r=0
LET d=conj(b) ! ペアノの曲線
CALL Afine(14)
WAIT DELAY 1

LET a=0
LET b=(3+SQR(3)*i)/6
LET r=0
LET d=conj(b) ! コッホの曲線
CALL Afine(12)

PLOT TEXT,AT 0.8,1.0:"END"
STOP

!----------
SUB Afine(Q)
FOR N=1 TO Q
CLEAR
DRAW axes
PLOT TEXT,AT 0.8,1.2,USING "N= %%":N
!-----
LET z=0
LET cx=1
CALL f0f1s(z) ! z=0の写像。記憶。
!-----
LET z=1
LET cx=1
CALL f0f1(z) ! z=1の写像。 z=0の写像と線でつなぐ。
!-----
WAIT DELAY 1.5-EXP(N/40)
NEXT N
END SUB

!----------
SUB f0f1s(z)
local f0,f1
LET f0=a*z+b*conj(z)
LET f1=r*z+d*conj(z)+1-r-d
IF s<N THEN
LET s=s+1
CALL f0f1s(f0)
CALL f0f1s(f1)
LET s=s-1
ELSE
LET z0(cx)=f0
LET cx=cx+1
LET z0(cx)=f1
LET cx=cx+1
END IF
END SUB

!----------
SUB f0f1(z)
local f0,f1
LET f0=a*z+b*conj(z)
LET f1=r*z+d*conj(z)+1-r-d
IF s<N THEN
LET s=s+1
CALL f0f1(f0)
CALL f0f1(f1)
LET s=s-1
ELSE
SET LINE COLOR MOD(cx,16)+1
PLOT LINES:re(z0(cx)),im(z0(cx)); re(f0),im(f0)
LET cx=cx+1
SET LINE COLOR MOD(cx,16)+1
PLOT LINES:re(z0(cx)),im(z0(cx)); re(f1),im(f1)
LET cx=cx+1
END IF
END SUB

END

フラクタル・ショー	返事を書く
諏訪 2006/07/23 17:51:31
! フラクタル・ショー SET WINDOW -0.7,1.9,-1.1,1.5 SET TEXT FONT "Times New Roman",16 OPTION ARITHMETIC COMPLEX DIM z0(2^16) LET i=SQR(-1) ! 虚数を i にセット。 LET s=1 !---------- LET a=0 LET b=(3+SQR(3)i)/6 LET r=0 LET d=2/3 ! 葉脈曲線 CALL Afine(14) LET a=(1+i)/2 LET b=0 LET r=0 LET d=conj(a) ! カニの行列 CALL Afine(15) LET a=(1+i)/2 LET b=0 LET r=0 LET d=-a ! ブロッコリー CALL Afine(15) WAIT DELAY 3 LET a=(1+i)/2 LET b=0 LET r=conj(a) LET d=0 ! レヴィのＣ曲線 CALL Afine(15) WAIT DELAY 2 LET a=(1+i)/2 LET b=0 LET r=a LET d=0 ! ドラゴン CALL Afine(15) WAIT DELAY 2 LET a=0 LET b=1-EXP(-PI/5i) LET r=0 LET d=conj(b) ! クリヌキ正五角形 CALL Afine(14) WAIT DELAY 1 LET a=0 LET b=(1+i)/2 LET r=0 LET d=conj(b) ! ペアノの曲線 CALL Afine(14) WAIT DELAY 1 LET a=0 LET b=(3+SQR(3)i)/6 LET r=0 LET d=conj(b) ! コッホの曲線 CALL Afine(12) PLOT TEXT,AT 0.8,1.0:"END" STOP !---------- SUB Afine(Q) FOR N=1 TO Q CLEAR DRAW axes PLOT TEXT,AT 0.8,1.2,USING "N= %%":N !----- LET z=0 LET cx=1 CALL f0f1s(z) ! z=0の写像。記憶。 !----- LET z=1 LET cx=1 CALL f0f1(z) ! z=1の写像。 z=0の写像と線でつなぐ。 !----- WAIT DELAY 1.5-EXP(N/40) NEXT N END SUB !---------- SUB f0f1s(z) local f0,f1 LET f0=az+bconj(z) LET f1=rz+dconj(z)+1-r-d IF s<N THEN LET s=s+1 CALL f0f1s(f0) CALL f0f1s(f1) LET s=s-1 ELSE LET z0(cx)=f0 LET cx=cx+1 LET z0(cx)=f1 LET cx=cx+1 END IF END SUB !---------- SUB f0f1(z) local f0,f1 LET f0=az+bconj(z) LET f1=rz+d*conj(z)+1-r-d IF s<N THEN LET s=s+1 CALL f0f1(f0) CALL f0f1(f1) LET s=s-1 ELSE SET LINE COLOR MOD(cx,16)+1 PLOT LINES:re(z0(cx)),im(z0(cx)); re(f0),im(f0) LET cx=cx+1 SET LINE COLOR MOD(cx,16)+1 PLOT LINES:re(z0(cx)),im(z0(cx)); re(f1),im(f1) LET cx=cx+1 END IF END SUB END