|
|
基本は１０年近く前に作った、”マンデルブロー集合”の計算プログラムです。
当時のパソコンでは、このサイズだと、結果が出るまで数時間かかってたと思います。
はるか昔、まだＣＰＵが８０８０の頃、初めてＢＡＳＩＣで組んで、結果待ちに３日以上かかったのも思い出です。
複素数モードにしたらもっと早くなるかもしれませんが、プリター出力と共にそれは宿題とですね。
最初に左下ＸＹ座標値と座標幅を入力（Xs=-2.1 Ys=-1.4 S=2.8で集合全体が出ます。）
後は結果を見て、マウスのドラッグで好きな範囲を選択して拡大していきます。
繰り返し回数Ｋ＝２５０ですが、拡大率が大きくなると、Ｋ＝１０００位にしないと
集合外ぎりぎりの点も入ってきてしまい、やや結果が甘くなります。
100 input prompt "Xs=":Xs
110 input prompt "Ys=":Ys
120 input prompt "S=":s
130 let pit=s/500
140 LET CT=0
1010 LET Ts=TIME
1020 SET BITMAP SIZE 530,550
1030 SET WINDOW 0,529,0,549
1040 SET POINT STYLE 1
1050 LET x$=STR$(Xs)
1060 LET Y$=STR$(Ys)
1070 LET s$=STR$(s)
1100 LET SS$="Xs="&X$&" :Ys="&Y$&" :S="&s$ ! 左下ＸＹ座標値と座標幅を表示
1110 PLOT TEXT ,AT 5,530 :SS$
2000 for m=0 to 499
2010 for n=0 to 499
2020 LET x=Xs+(m*pit)
2030 LET y=Ys+(n*pit)
2031 let px=x
2032 let py=y
2035 LET a=0
2040 FOR k=1 TO 250 ! この数値を大きくする場合３０００行からの色指標のオーバーに注意
2050 LET Z=x^2+y^2
2060 LET Cx=x^2-y^2+px
2070 LET Cy=2*x*y+py
2080 if Z>4 then gosub 3000
2090 let x=Cx
2100 LET y=Cy
2105 LET Ct=Ct+1
2110 if a=1 then 2220
2200 next k
2210 gosub 4000
2220 next n
2230 next m
2500 GOTO 5000
3000 LET c=k
3020 LET c=c+2
3050 set point color c
3060 PLOT POINTS:m,n
3070 LET a=1
3080 return
4000 rem if a=1 then return
4010 set point color 1
4020 plot points:m,n
4030 RETURN
5000 LET Ct$=STR$(Ct) ! 繰り返し回数と計算時間を表示
5010 LET Te=TIME-Ts
5020 LET T$=STR$(Te)
5030 LET ST$=Ct$&" T="&T$
5040 PLOT TEXT ,AT 5,510 :ST$
6000 CHARACTER INPUT PROMPT " DRAW GRID？（ｙ／ｎ）":D$ ! 結果に１０×１０のグリッドを入れるか？
6010 IF D$="n" THEN 7000
6020 DRAW GRID(50,50)
7000 PAUSE "拡大する範囲を指定してください" ! 正方形領域を取得する
7010 CALL GetSquare(Bx,Ty,Tx,By)
8010 LET Xs=Xs+(S*(Bx/500))
8020 LET Ys=Ys+(S*(By/500))
8030 LET S=S*(ABS(Tx-Bx)/500)
8040 CLEAR
8050 GOTO 130
10000 end
! マウスによる正方形領域取得副プログラム
EXTERNAL SUB GetSquare(l,t,r,b)
ASK LINE STYLE LStyle
SET DRAW MODE NOTXOR
SET LINE STYLE 2
DO
MOUSE POLL l,t,i,j
LOOP WHILE i=0
LET l0=l
LET t0=t
LET r0=l0
LET b0=t0
PLOT LINES: l0,t0; l0,b0; r0,b0; r0,t0; l0,t0
DO WHILE i=1
MOUSE POLL r,b,i,j
LET w=r-l
LET h=t-b
IF ABS(h) < ABS(w) THEN
LET b=t-SGN(h)*ABS(w)
ELSE
LET r=l+SGN(w)*ABS(h)
END IF
IF l0<>l OR r0<>r OR b0<>b OR t0<>t THEN
PLOT LINES: l0,t0; l0,b0; r0,b0; r0,t0; l0,t0
PLOT LINES: l,t; l,b; r,b; r,t; l,t
LET l0=l
LET t0=t
LET r0=r
LET b0=b
END IF
LOOP
WAIT DELAY 1
PLOT LINES: l,t; l,b; r,b; r,t; l,t
SET DRAW MODE OVERWRITE
SET LINE STYLE LStyle
IF l>r THEN SWAP l,r
IF b>t THEN SWAP b,t
END SUB
|
|