|
> No.4500[元記事へ]
しばっちさんへのお返事です。
> yoshipyutaさんへのお返事です。
>
> > Dr.MihaelBeckerによると下段のような明確なパターンであると主張しています。精度KSの問題でもないようです。白黒ラインでラインを強く出す方法は考えられませんか?
>
> 一般的な方法ではないのなら、特殊な方法で収束判定しているとしか思えません。
> どこかにその方法が記されていない限り、理論も理解していない素人がその方法を思いつくことはありえません。
> 素人の私には残念ながら分かりません。yoshipyutaさんの方が、このjulia集合に関して詳しいのではないでしょうか。
> ネット上にその回答があるのかは分かりませんが、ネットで調べるなりDr.MihaelBeckerの文献等を調べるかしない限り、その方法は分からないと思います。
カリンさんが2010年に公開されている以下のCodeにも、参考になるかも知れません。なんとNewton Fractalの境界を光り輝くラインで描画しています。是非、しばっち流に改善してFractal研究に使わせて下さい。
!10進BASIC専用
!任意の範囲をドラッグ+正方形クリックで拡大操作
!
!カラーコード 193色(RGB)
data 000000
data FF0000,FF0800,FF1000,FF1800,FF2000,FF2800,FF3000,FF3800,FF4000,FF4800,FF5000,FF5800,FF6000,FF6800,FF7000,FF7800
data FF8000,FF8800,FF9000,FF9800,FFA000,FFA800,FFB000,FFB800,FFC000,FFC800,FFD000,FFD800,FFE000,FFE800,FFF000,FFF800
data FFFF00,F8FF00,F0FF00,E8FF00,E0FF00,D8FF00,D0FF00,C8FF00,C0FF00,B8FF00,B0FF00,A8FF00,A0FF00,98FF00,90FF00,88FF00
data 80FF00,78FF00,70FF00,68FF00,60FF00,58FF00,50FF00,48FF00,40FF00,38FF00,30FF00,28FF00,20FF00,18FF00,10FF00,08FF00
data 00FF00,00FF08,00FF10,00FF18,00FF20,00FF28,00FF30,00FF38,00FF40,00FF48,00FF50,00FF58,00FF60,00FF68,00FF70,00FF78
data 00FF80,00FF88,00FF90,00FF98,00FFA0,00FFA8,00FFB0,00FFB8,00FFC0,00FFC8,00FFD0,00FFD8,00FFE0,00FFE8,00FFF0,00FFF8
data 00FFFF,00F8FF,00F0FF,00E8FF,00E0FF,00D8FF,00D0FF,00C8FF,00C0FF,00B8FF,00B0FF,00A8FF,00A0FF,0098FF,0090FF,0088FF
data 0080FF,0078FF,0070FF,0068FF,0060FF,0058FF,0050FF,0048FF,0040FF,0038FF,0030FF,0028FF,0020FF,0018FF,0010FF,0008FF
data 0000FF,0800FF,1000FF,1800FF,2000FF,2800FF,3000FF,3800FF,4000FF,4800FF,5000FF,5800FF,6000FF,6800FF,7000FF,7800FF
data 8000FF,8800FF,9000FF,9800FF,A000FF,A800FF,B000FF,B800FF,C000FF,C800FF,D000FF,D800FF,E000FF,E800FF,F000FF,F800FF
data FF00FF,FF00F8,FF00F0,FF00E8,FF00E0,FF00D8,FF00D0,FF00C8,FF00C0,FF00B8,FF00B0,FF00A8,FF00A0,FF0098,FF0090,FF0088
data FF0080,FF0078,FF0070,FF0068,FF0060,FF0058,FF0050,FF0048,FF0040,FF0038,FF0030,FF0028,FF0020,FF0018,FF0010,FF0008
declare sub shift_sfn
declare sub fpr_sfn
declare sub select_area
declare sub updateparam
declare sub draw_area
declare sub tdraw_area
declare sub flood_area
declare sub draw_point
declare sub pointdraw
declare sub draw_side
declare sub draw_inside
declare sub draw_srline
declare sub printdata
set point style 1
set color mode "native"
set draw mode explicit
option base 0
option arithmetic complex
declare function fcos !複素数拡張 cos() 関数
declare function fsin !複素数拡張 sin() 関数
let cnum = 193 !色数(64×3+1)
let kcn = cnum-1
let kcolor = 1/255 !RGB指数変換定数(24bits)
dim ind(kcn) !色指標用配列
let undolimit = 100
let ul = undolimit
let lv = 0
dim graphics(ul)
dim realpartmin(ul),imaginarypartmin(ul)
dim realpartmax(ul),imaginarypartmax(ul)
dim repeatlimit(ul),uupdate(ul)
!━━━━━━━━━━━━━━━━━━━━━━━━━━━カラーコードを色指標に変換━━━━━━━━━━━━━━━━━━━━
for g1 = 0 to kcn
read cl$
let r = bval(cl$(1:2),16)*kcolor
let g = bval(cl$(3:4),16)*kcolor
let b = bval(cl$(5:6),16)*kcolor
let ind(g1) = colorindex(r,g,b)
next g1
!━━━━━━━━━━━━━━━━━━━━━━━━━━━境界走査―境界描画と境界判定━━━━━━━━━━━━━━━━━━━
sub draw_side
for gx = mgx to mgxp
let gxf = gx1 + krg*gx
let gy = mgy
let gyf = gy1 + krg*gy
call draw_point!<--------------------------------draw_point -> pointdraw で判定
let gy = mgyp
let gyf = gy1 + krg*gy
call draw_point!<--------------------------------draw_point -> pointdraw で判定
next gx
for gy = mgy1 to mgym
let gyf = gy1 + krg*gy
let gx = mgx
let gxf = gx1 + krg*gx
call draw_point!<--------------------------------draw_point -> pointdraw で判定
let gx = mgxp
let gxf = gx1 + krg*gx
call draw_point!<--------------------------------draw_point -> pointdraw で判定
next gy
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━境界走査―内部の描画━━━━━━━━━━━━━━━━━━━━━━━
sub draw_inside(grx,gry)
let mgy = mgyt*grc
let mgyp = mgy+gry-1
let mgy1 = mgy+1
let mgym = mgyp-1
let sign = 1
call draw_side!<------------------------------------境界の計算、描画と判定
if sign = 1 then!-----------------------------------境界点がすべて非収束か非発散の場合内部も同様とみなす
call flood_area(mgx,mgy,mgx+grx-1,mgy+gry-1,ind(0))
else!<----------------------------------------------sign = 0 のときの内部計算と描画
for gx = mgx1 to mgxm
let gxf = gx1 + krg*gx
for gy = mgy1 to mgym
let gyf = gy1 + krg*gy
call draw_point
next gy
next gx
end if
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━境界走査―各列描画━━━━━━━━━━━━━━━━━━━━━━━━
sub draw_srline(grx1,gry1,gry2)
set draw mode hidden
let mgx = mgxt*grc
let mgxp = mgx+grx1-1
let mgx1 = mgx+1
let mgxm = mgxp-1
call flood_area(mgx,0,mgxp,wx,colorindex(1,1,1))!<---塗りつぶしを上手くするために描画する部分を消す
for mgyt = 0 to div
call draw_inside(grx1,gry1)
next mgyt
!---------------------------------------------------画像サイズが境界サイズで割り切れない場合の余り部分の描画
if gmod = 1 then
call draw_inside(grx1,gry2)
end if
set draw mode explicit
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━収束回数による色分けと点の描画━━━━━━━━━━━━━━━━━━
sub pointdraw
!------------------------------------------------------収束しないまたは振動の場合
if k = pn then
let nb = 0
else
!---------------------------------------------------収束または発散した場合 k が収束か発散までの反復回数
let nb = mod(k,kcn) + 1
let sign = 0!<-----------------------------------収束か発散した点が存在したとき sign = 0 として内部計算も行う
end if
set color ind(nb)
plot points :gx,gy
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━数列 z(n) の収束、振動及び発散の判定と描画━━━━━━━━━━━━
sub draw_point
when exception in
let c = complex(gxf,gyf)
call fpr_sfn
let zd = 1
let k = 1
!------------------------------------------------収束、発散の判定文
do while k =< num and abs(zd) > mindt and abs(zd) < maxdt
let gz = z
call shift_sfn
let zd = z-gz
let k = k + 1
loop
!------------------------------------------------
call pointdraw
use
call pointdraw
end when
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━拡大範囲選択の四角の描画━━━━━━━━━━━━━━━━━━━━━
sub tdraw_area
call draw_area(x1,y1,x1+trangex,y1+trangey,colorindex(0,0,1))
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━描画データの表示━━━━━━━━━━━━━━━━━━━━━━━━━
sub printdata
print "実部 "&str$(gx1)&"≦Re≦"&str$(gx2)
print "虚部 "&str$(gy1)&"≦Im≦"&str$(gy2)
print "幅 "&str$(xrange)
print "中心座標 ("&str$(lpx1)&","&str$(lpy1)&")"
print "色数 "&str$(cnum)&"色"
print "画像サイズ "&str$(wx)&"pixel×"&str$(wx)&"pixel"
print "境界走査幅 "&str$(grc)&"pixel"
print "計算回数 "&str$(num)&"回"
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━拡大部分の選択と画像保存、終了の操作をする━━━━━━━━━━━━
sub select_area
let left = 0
let right = 0
do while left = 0 and right = 0
mouse poll dx1,dy1,left,right
loop
if right = 1 then
if lu <> 1 then
let lu = lu - 1
set draw mode hidden
gload "~table"&str$(lu)&".bmp"
set draw mode explicit
set draw mode notxor
let wx = graphics(lu)
set window 0,wx-1,0,wx-1
end if
end if
if left = 1 then
set draw mode notxor
let x1 = dx1
let y1 = dy1
let x2 = x1
let y2 = y1
let update = 1
let trangex = 0
let trangey = 0
call tdraw_area
set draw mode hidden
do while left = 1
mouse poll x3,y3,left,right
if x3 <> x2 or y3 <> y2 then
set draw mode hidden
call tdraw_area
let trange = max(abs(x1-x3),abs(y1-y3))
let trangex = sgn(x3-x1)*trange
let trangey = sgn(y3-y1)*trange
set draw mode explicit
call tdraw_area
let x2 = x3
let y2 = y3
end if
loop
if x1 = x2 and y1 = y2 then
if lu <> lv then
let lu = lu + 1
set draw mode hidden
gload "~table"&str$(lu)&".bmp"
set draw mode explicit
set draw mode notxor
let wx = graphics(lu)
set window 0,wx-1,0,wx-1
end if
exit sub
end if
let left = 0
let right = 0
do while left = 0 and right = 0
mouse poll x4,y4,left,right
loop
let gx41 = sgn(x4-x1)
let tx41 = sgn(x4-x1-trangex)
let gy41 = sgn(y4-y1)
let ty41 = sgn(y4-y1-trangey)
if left = 1 then
if gx41 <> tx41 and gy41 <> ty41 then
let cont = 1
else
let cont = 0
call tdraw_area
end if
end if
if right = 1 then
if gx41 <> tx41 and gy41 <> ty41 then
call updateparam
let cont = 1
else
let cont = 0
call tdraw_area
do while right = 1
mouse poll x5,y5,left,right
loop
end if
end if
end if
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━描画範囲変更に伴う各値の更新━━━━━━━━━━━━━━━━━━━
sub updateparam
input prompt "繰り返しの回数、画像サイズ、境界走査サイズ":num,wx,grc
let cont = 1
if mod(wx,grc) <> 0 then
let gmod = 1
let grm = mod(wx,grc)
else
let gmod = 0
end if
let uupdate(lu) = 1
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
!------------------------------------------------------初期値
let wx = 556 !グラフィックス画面の横画素数
let wy = wx !グラフィックス画面の縦画素数
let num = 256 !反復計算回数の上限
let lpx1_ = 0.0000001!グラフィックス画面の中心の実座標
let lpy1_ = 0.0000001!グラフィックス画面の中心の虚座標
let xrange_ = 8 !グラフィックス画面に割り当てる複素平面の範囲(初回描画時)
let mindt = 1e-10 !|z(n)-z(n+1)|=<mindtの時収束と判定する
let maxdt = 1e+10 !|z(n)-z(n+1)|>=maxdtの時発散と判定する
let grc = 10 !描画中再描画するまで計算するライン数
let grt = 1 !描画ラインカウント変数
let grm = 0
let lpx1 = lpx1_
let lpy1 = lpy1_
let xrange = xrange_
let zd = 1 !|z(n)-z(n+1)|を代入する変数
let gmod = 0
set bitmap size wx,wx
let gx1 = lpx1 - xrange/2
let gy1 = lpy1 - xrange/2
let gx2 = lpx1 + xrange/2
let gy2 = lpy1 + xrange/2
let count = 0
let wx_ = wx+1
let i = complex(0,1) !虚数単位
if mod(wx,grc) <> 0 then
let gmod = 1
let grm = mod(wx,grc)
end if
call printdata
!━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
do while count <> 1
set draw mode overwrite
if wx <> wx_ then set bitmap size wx,wx
set window 0,wx-1,0,wx-1
let wx_ = wx
let krg = xrange/wx
let pn = num + 1
let start_time = time
let div = int(wx/grc)-1
let lv = lv + 1
let graphics(lv) = wx
let realpartmin(lv) = gx1
let imaginarypartmin(lv) = gy1
let realpartmax(lv) = gx2
let imaginarypartmax(lv) = gy2
let repeatlimit(lv) = num
!---------------------------------------------------描画総括
for mgxt = 0 to div
call draw_srline(grc,grc,grm)
next mgxt
if gmod = 1 then
call draw_srline(grm,grc,grm)
end if
!---------------------------------------------------拡大操作
set draw mode explicit
set draw mode notxor
print "計算時間 "&str$(round(time-start_time,3))&"秒"
print
gsave "~table"&str$(lv)&".bmp"
let lu = lv
let cont = 0
do while cont = 0
do while left = 1 or right = 1
mouse poll dxu,dyu,left,right
loop
call select_area
loop
if lv <> lu and uupdate(lu) = 0 then
let lv = lu
let wx = graphics(lu)
let gx1 = realpartmin(lu)
let gy1 = imaginarypartmin(lu)
let gx2 = realpartmax(lu)
let gy2 = imaginarypartmax(lu)
let num = repeatlimit(lu)
let krg = abs(gx1-gx2)/wx
end if
!---------------------------------------------------描画範囲変更に伴う各値の更新
if update = 1 then
let gx1_= gx1
let gy1_= gy1
let gx1 = gx1_+min(x1,x1+trangex)*krg
let gy1 = gy1_+min(y1,y1+trangey)*krg
let gx2 = gx1_+max(x1,x1+trangex)*krg
let gy2 = gy1_+max(y1,y1+trangey)*krg
let lpx1 = (gx1+gx2)/2
let lpy1 = (gy1+gy2)/2
let xrange = abs(trangex)*krg
let update = 0
end if
!---------------------------------------------------
call printdata
let uupdate(lu) = 0
loop
!━━━━━━━━━━━━━━━━━━━━━━━━━━━長方形を作る━━━━━━━━━━━━━━━━━━━━━━━━━━━
sub draw_area(x1,y1,x2,y2,cind)
set color cind
plot lines : x1,y1 ; x1,y2 ; x2,y2 ; x2,y1 ; x1,y1
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━長方形塗りつぶし━━━━━━━━━━━━━━━━━━━━━━━━━
sub flood_area(x1,y1,x2,y2,cind)
set area color cind
plot area : x1,y1 ; x1,y2 ; x2,y2 ; x2,y1 ; x1,y1
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━複素三角関数━━━━━━━━━━━━━━━━━━━━━━━━━━━
function fsin(z_)
let fsin = (exp(i*z_)-exp(-i*z_))/(2*i)
end function
function fcos(z_)
let fcos = (exp(i*z_)+exp(-i*z_))/2
end function
!━━━━━━━━━━━━━━━━━━━━━━━━━━━数列z(n)の反復式━━━━━━━━━━━━━━━━━━━━━━━━━
sub shift_sfn
let z2 = z*z
LET z = z-(z3*z2+z*z2*c+c)/(5*z2*z2+3*z2*c)
end sub
!━━━━━━━━━━━━━━━━━━━━━━━━━━━数列z(n)の初期値と複素数の変換式━━━━━━━━━━━━━━━━━
sub fpr_sfn
! let c = c
let z = -c/2 !数列z(n)の初期値
end sub
end
|
|