フラクタル・トレーサー

! フラクタル・トレーサー
SET TEXT FONT "",16

OPTION ARITHMETIC COMPLEX
DIM z0(2^16) ! N=16 最大
LET i=SQR(-1) ! i= 虚数
LET s=1

!----------
DO
LET a=0
LET b=(3+SQR(3)*i)/6
LET r=0
LET d=2/3
CALL Afine("葉脈曲線", 0.5, 0.1, 0.6)

LET a=(1+i)/2
LET b=0
LET r=0
LET d=conj(a)
CALL Afine("カニの行列", 0.35, 0.3, 0.7)

LET a=(1+i)/2
LET b=0
LET r=conj(a)
LET d=0
CALL Afine("レヴィのＣ曲線", 0.5, 0.3, 1.1)

LET a=(1+i)/2
LET b=0
LET r=a
LET d=0
CALL Afine("ドラゴン", 0.5, 0, 1)

LET a=0
LET b=(1+i)/2
LET r=0
LET d=conj(b)
CALL Afine("ペアノの曲線", 0.5, 0.2, 0.6)

LET a=0
LET b=(3+SQR(3)*i)/6
LET r=0
LET d=conj(b)
CALL Afine("コッホの曲線", 0.5, 0.1, 0.6) ! ( 中心X, 中心Y, 半幅)
LOOP

!----------
SUB Afine(t$,xm,ym,h)
SET WINDOW xm-h,xm+h, ym-h,ym+h
DO
CLEAR
DRAW grid
PLOT TEXT,AT xm,ym+h*0.9:t$
PLOT TEXT,AT xm,ym+h*0.8, USING "N= %%":N
IF N=0 THEN
beep
SET LINE COLOR 2
PLOT LINES: 0,0; 1,0 ! 親集合 Z=0~1 の線。
!SET POINT COLOR 2
PLOT POINTS: (0*1+1*9)/10,0
ELSE
LET z=0
LET cx=1
CALL f0f1s(z) ! z=0の写像。記憶。
!-----
LET z=1
LET cx=1
CALL f0f1(z) ! z=1の写像。 z=0の写像と線でつなぐ。
END IF
CHARACTER INPUT PROMPT "　ＥＳＣ　で、終了"&CHR$(9)&
&&"　ＳＰＡＣＥ　で、曲線選択"&CHR$(13)&
&&"　ＥＮＴＥＲ　で、Ｎ＋１"&CHR$(9)&
&&"　ＢＡＣＫＳＰ　で、Ｎ－１":k$
IF k$=CHR$(27) THEN STOP
IF k$=" " THEN EXIT DO
IF k$=CHR$(13) THEN
IF N<16 THEN LET N=N+1
ELSEIF k$=CHR$(08) THEN
IF 0<N THEN LET N=N-1
END IF
LOOP
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)
IF N<10 THEN PLOT POINTS:(re(z0(cx))+re(f0)*9)/10,(im(z0(cx))+im(f0)*9)/10
LET cx=cx+1
SET LINE COLOR MOD(cx,16)+1
PLOT LINES:re(z0(cx)),im(z0(cx)); re(f1),im(f1)
IF N<10 THEN PLOT POINTS:(re(z0(cx))+re(f1)*9)/10,(im(z0(cx))+im(f1)*9)/10
LET cx=cx+1
END IF
END SUB

END

フラクタル・トレーサー	返事を書く
諏訪 2006/07/28 00:36:53
! フラクタル・トレーサー SET TEXT FONT "",16 OPTION ARITHMETIC COMPLEX DIM z0(2^16) ! N=16 最大 LET i=SQR(-1) ! i= 虚数 LET s=1 !---------- DO LET a=0 LET b=(3+SQR(3)i)/6 LET r=0 LET d=2/3 CALL Afine("葉脈曲線", 0.5, 0.1, 0.6) LET a=(1+i)/2 LET b=0 LET r=0 LET d=conj(a) CALL Afine("カニの行列", 0.35, 0.3, 0.7) LET a=(1+i)/2 LET b=0 LET r=conj(a) LET d=0 CALL Afine("レヴィのＣ曲線", 0.5, 0.3, 1.1) LET a=(1+i)/2 LET b=0 LET r=a LET d=0 CALL Afine("ドラゴン", 0.5, 0, 1) LET a=0 LET b=(1+i)/2 LET r=0 LET d=conj(b) CALL Afine("ペアノの曲線", 0.5, 0.2, 0.6) LET a=0 LET b=(3+SQR(3)i)/6 LET r=0 LET d=conj(b) CALL Afine("コッホの曲線", 0.5, 0.1, 0.6) ! ( 中心X, 中心Y, 半幅) LOOP !---------- SUB Afine(t$,xm,ym,h) SET WINDOW xm-h,xm+h, ym-h,ym+h DO CLEAR DRAW grid PLOT TEXT,AT xm,ym+h0.9:t$ PLOT TEXT,AT xm,ym+h0.8, USING "N= %%":N IF N=0 THEN beep SET LINE COLOR 2 PLOT LINES: 0,0; 1,0 ! 親集合 Z=0~1 の線。 !SET POINT COLOR 2 PLOT POINTS: (01+19)/10,0 ELSE LET z=0 LET cx=1 CALL f0f1s(z) ! z=0の写像。記憶。 !----- LET z=1 LET cx=1 CALL f0f1(z) ! z=1の写像。 z=0の写像と線でつなぐ。 END IF CHARACTER INPUT PROMPT "　ＥＳＣ　で、終了"&CHR$(9)& &&"　ＳＰＡＣＥ　で、曲線選択"&CHR$(13)& &&"　ＥＮＴＥＲ　で、Ｎ＋１"&CHR$(9)& &&"　ＢＡＣＫＳＰ　で、Ｎ－１":k$ IF k$=CHR$(27) THEN STOP IF k$=" " THEN EXIT DO IF k$=CHR$(13) THEN IF N<16 THEN LET N=N+1 ELSEIF k$=CHR$(08) THEN IF 0<N THEN LET N=N-1 END IF LOOP 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+dconj(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) IF N<10 THEN PLOT POINTS:(re(z0(cx))+re(f0)9)/10,(im(z0(cx))+im(f0)9)/10 LET cx=cx+1 SET LINE COLOR MOD(cx,16)+1 PLOT LINES:re(z0(cx)),im(z0(cx)); re(f1),im(f1) IF N<10 THEN PLOT POINTS:(re(z0(cx))+re(f1)9)/10,(im(z0(cx))+im(f1)9)/10 LET cx=cx+1 END IF END SUB END