teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助画像・ファイル<IMG>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ] [ 検索 ]

スレッド一覧

  1. スレッドが使えます(2)
  2. Paract BASIC(21)
  3. Amusement_Program(10)
  4. 改修予定のJIS非互換(3)
  5. 複数ページ長編プログラム(新規投稿)(16)
  6. 「十進BASIC第2掲示板」投稿記事リスト(17)
  7. Full BASIC互換ライブラリ(8)
  8. 「十進BASIC掲示板過去ログ」インデックス(トピック)(17)
  9. 人の色覚の数理(14)
  10. 「十進BASIC掲示板過去ログ」インデックス(ツリー)(91)
スレッド一覧(全10)  他のスレッドを探す  スレッド作成

*掲示板をお持ちでない方へ、まずは掲示板を作成しましょう。無料掲示板作成


しばっち様

 投稿者:大熊 正  投稿日:2018年 2月16日(金)11時40分49秒
返信・引用
  早速のご返答ありがとうございます。

更に、勝手ながらこのプログラムを含む他の有用なプログラムが詰まっていた大元の
プログラム集の http//::::::  をご存知でしたらお知らせお願いいたします。
 
 

Re: プログラムを探しています

 投稿者:しばっち  投稿日:2018年 2月13日(火)20時13分12秒
返信・引用
  > No.4503[元記事へ]

大熊 正さんへのお返事です。

> 実は、PERT のプログラムをさがしています。昔、2008年ごろ投稿し、山中和義 氏 に作っていただき、氏のプログラム集にのっていました。

下記URLのことでしょうか?

http://6317.teacup.com/basic/bbs/1076
 

Re: プログラムを探しています

 投稿者:白石 和夫  投稿日:2018年 2月13日(火)13時06分26秒
返信・引用 編集済
  > No.4503[元記事へ]

大熊 正さんへのお返事です。

COMM.BASの1行目は,

! COMポートによる送受信のテストプログラムです。

となっています。!は,!以降,行末までの部分が注釈だということを指示します。
COMポートは,シリアル接続による通信経路のことです。最近のPCはシリアルポートを持たないのが普通になりましたが,USB接続のデバイスで仮想CMMポートを介して制御するものもあるので,残してあります。

 

プログラムを探しています

 投稿者:大熊 正  投稿日:2018年 2月13日(火)12時28分48秒
返信・引用
  NO.4485 の投稿者です。白石先生 ありがとうございました。
実は、PERT のプログラムをさがしています。昔、2008年ごろ投稿し、山中和義 氏 に作っていただき、氏のプログラム集にのっていました。

氏のプログラム集は当時の掲示板サイトの下のほうに行き先があったと記憶しております。
再度、PERTをしようする必要に迫られるさがしております。

インターネットで調べましたがわかりません。何方かお教えください。

10進数BASICでファイル(F)を開き一番うえの COMM を偶然開きいじっていたら、PCが
停止し、動かなくなりました。私の知りたいのは、これがどういうソフトでどういうときに
使うのかという事です。

どうように、編集(E)とかオプション(O)等々の説明や使い方をおしえてください。

敬具
 

Re: マンデルブロート(ジュリア)

 投稿者:yoshipyuta  投稿日:2018年 2月 9日(金)11時30分47秒
返信・引用
  > No.4500[元記事へ]

しばっちさんへのお返事です。

> yoshipyutaさんへのお返事です。
>
> > Dr.MihaelBeckerによると下段のような明確なパターンであると主張しています。精度KSの問題でもないようです。白黒ラインでラインを強く出す方法は考えられませんか?
>
> 一般的な方法ではないのなら、特殊な方法で収束判定しているとしか思えません。
> どこかにその方法が記されていない限り、理論も理解していない素人がその方法を思いつくことはありえません。
> 素人の私には残念ながら分かりません。yoshipyutaさんの方が、このjulia集合に関して詳しいのではないでしょうか。
> ネット上にその回答があるのかは分かりませんが、ネットで調べるなりDr.MihaelBeckerの文献等を調べるかしない限り、その方法は分からないと思います。


カリンさんが2010年に公開されている以下のCodeにも、参考になるかも知れません。なんとNewton Fractalの境界を光り輝くラインで描画しています。是非、しばっち流に改善してFractal研究に使わせて下さい。

!Copyright(C) 2010 かりん All Rights Reserved. http://web-box.jp/rgbkarin/fractal.txt
!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




 
 

Re: マンデルブロート(ジュリア)

 投稿者:yoshipyuta  投稿日:2018年 2月 9日(金)10時27分49秒
返信・引用
  > No.4500[元記事へ]

しばっちさんへのお返事です。

> yoshipyutaさんへのお返事です。
>
> > Dr.MihaelBeckerによると下段のような明確なパターンであると主張しています。精度KSの問題でもないようです。白黒ラインでラインを強く出す方法は考えられませんか?
>
> 一般的な方法ではないのなら、特殊な方法で収束判定しているとしか思えません。
> どこかにその方法が記されていない限り、理論も理解していない素人がその方法を思いつくことはありえません。
> 素人の私には残念ながら分かりません。yoshipyutaさんの方が、このjulia集合に関して詳しいのではないでしょうか。
> ネット上にその回答があるのかは分かりませんが、ネットで調べるなりDr.MihaelBeckerの文献等を調べるかしない限り、その方法は分からないと思います。

ご迷惑をおかけしています。この問題は恐らく収束法判定の問題ではなくてTechnial Colouringの選択か?と思います。Dr.Mihael BeckerはソースCodeを公開していないので分かりませんが、点Plotではなく、J境界を陰関数表示している?まさかトレースではないと思いますが。

類似問題は実はNewton Fractalでもあります。しばっち・Newtonプログラム②でf(z)=z^3-2*z+2,R = 0.98を描くと上段の図が得られます。骨格ラインのみを強調すると(どうやって?)下段の図となります。

次のサイトのDistance Shadingという手法かな?と思ったりします。Codeも公開しています。


http://usefuljs.net/fractals/docs/algorithms.html

function colourDistance
parameters: h, s, v: real: components of the HSV colour space;
    distance: real: the distance estimate calculated during iteration;
    pixelWidth: real: the width represented by a pixel on the screen;
    boundaryFraction: real: value > 0 used to control prominence of the boundary

let:
    dScale = log2(distance / pixelWidth),
    factor = 0;

if (dScale > 0) {
    factor = 1;
}
else if (dScale > -boundaryFraction) {
    factor = (boundaryFraction + dScale) / boundaryFraction;
}

// Darken v when factor < 1
return hsv2rgb(h, s, v * factor);

私やKidsにはさっぱり分かりませんので、是非チャレンジされて、お示しください。次のRoot Finding法も興味深い。

Finding Complex Roots of a Function
Basin colouring for Newtonian fractals requires us to know the roots of the function before we generate the fractal.

We can also anticipate a future requirement of identifying critical points of a function for generating Mandelbrot sets. Therefore, we need a generic root finding algorithm. This algorithm uses - what else? - Newton's method.

definition rootObject
properties: x: the real component of z;
    y: the imaginary component of z;
    r: the modulus of z;
    theta: the angle of z

function findRoots
parameters: f: a pointer to a function that takes a complex number, z, and computes f(z);
    fprime: a pointer to a function that takes a complex number, z, and computes f?(z)
constants: XMAX, XMIN, YMAX, YMIN: the limits of the complex plane to be tested

let:
    eV = 1e-8,
    // For checking suspiciously small real / imaginary components
    delta = eV * 100,
    // For comparing roots found
    tolerance = delta * 100,
    rSpan = XMAX - XMIN,
    iSpan = YMAX - YMIN,
    // If we don't find a root after n iterations, give up and move on
    iterations = 100,
    // We'll test this many points in the x- and y- axes
    points = 30,
    rInt = rSpan / points,
    iInt = iSpan / points,
    roots = [];

// Test a reasonably large sample of points in the plane; assuming that we only have to
// do this when we regenerate a fractal, we can use a conservatively large value to minimize
// the chances of failing to find distinct roots that are close to each other
for (i = 0..points) {
    for(j = 0..points) {
        let:
            x = XMIN + i * rInt,
            y = YMIN + j * iInt,
            diff = 1,
            iter = 0;

        while (iter < iterations AND diff > eV) {
            // Get the numerator and denominator
            [nomX, nomY] = f(x, y);
            [denomX, denomY] = fprime(x, y);

            // Divide f(z) by f'(z) - multiply through by conjugate of denominator
            tmp = nomX * denomX + nomY * denomY;
            nomY = nomY * denomX - nomX * denomY;
            nomX = tmp;
            denomX = denomX * denomX + denomY * denomY;
            if (!denomX) {
                // Try another number
                break;
            }
            // Now we can divide
            _x = x - nomX / denomX;
            _y = y - nomY / denomX;

            // Get the differences from last round
            diffX = x - _x;
            diffY = y - _y;
            diff = sqrt(diffX * diffX + diffY * diffY);
            // Set up the next guess
            x = _x;
            y = _y;
            ++iter;
        }

        if (diff < eV) {
            let:
                newRoot = TRUE;
            // Zero suspiciously small real / imaginary components so that the roots can
            // be sorted deterministically
            if (abs(x) < delta) {
                x = 0;
            }
            if (abs(y) < delta) {
                y = 0;
            }
            for (k = 0..LENGTH(roots)) {
                if (complexCompare(x, y, roots[k].x, roots[k].y, tolerance)) {
                    newRoot = FALSE;
                    break;
                }
            }
            if (newRoot) {
                push(roots, rootObject{ x : x, y : y, r : sqrt(x * x + y * y), theta : atan2(y, x) });
            }
        }
    }
}

SORT roots;
return roots;
 

Re: マンデルブロート(ジュリア)

 投稿者:しばっち  投稿日:2018年 2月 8日(木)20時18分45秒
返信・引用
  > No.4496[元記事へ]

yoshipyutaさんへのお返事です。

> Dr.MihaelBeckerによると下段のような明確なパターンであると主張しています。精度KSの問題でもないようです。白黒ラインでラインを強く出す方法は考えられませんか?

一般的な方法ではないのなら、特殊な方法で収束判定しているとしか思えません。
どこかにその方法が記されていない限り、理論も理解していない素人がその方法を思いつくことはありえません。
素人の私には残念ながら分かりません。yoshipyutaさんの方が、このjulia集合に関して詳しいのではないでしょうか。
ネット上にその回答があるのかは分かりませんが、ネットで調べるなりDr.MihaelBeckerの文献等を調べるかしない限り、
その方法は分からないと思います。
 

Re: 使い方を教えてください。

 投稿者:SHIRAISHI kazuo  投稿日:2018年 2月 8日(木)17時49分35秒
返信・引用 編集済
  > No.4495[元記事へ]

とりあえず
http://www.koshigaya.bunkyo.ac.jp/shiraish/basic/tutorial/section1.htm
を見てください。
ZIPを解凍してできるフォルダにも,tutorial.pdfという名称でほぼ同じものが同梱されています。

プログラムの保存先は,特に規定はありません。


 

Re: notxorモードなのにplot label二度書きでも消えない?

 投稿者:あおきたいち  投稿日:2018年 2月 8日(木)06時19分30秒
返信・引用
  > No.4493[元記事へ]

素早いご回答ありがとうございます。
すいません、ヘルプの当該部分を読めていなかったです。仕様ということを承知しました。

> 十進BASICヘルプより抜粋
>
> 以下の文は,画面上の色と描画に用いる色との混色の仕方を定める。
> ただし,PLOT TEXT文以外による文字の描画には適用しない。
> (DRAW GRID,DRAW AXESが描く文字にも適用されない)
 

Re: PLOT TEXTのバグ?

 投稿者:あおきたいち  投稿日:2018年 2月 8日(木)06時13分52秒
返信・引用
  > No.4494[元記事へ]

> SET TEXT HEIGHTを実行して適正なサイズに変えてみてください。

素早いご回答ありがとうございます。表示されました。
 

Re: マンデルブロート(ジュリア)

 投稿者:yoshipyuta  投稿日:2018年 2月 8日(木)00時10分52秒
返信・引用
  > No.4485[元記事へ]

しばっちさんへの質問です。

>
> > 下図中段の  https://kukuruku.co/post/julia-set/にあるような描画法とはどのようなものですか?
> >
> > 拡大すると明瞭に渦の会合が観察されます。この描画可能でしょうか。
>
> 上記サイト内にソースリストがありますので、とりあえず移植を試みてみました。
> しかしながら、この言語についての知識はなく、不明な点もありパラメータも不明なので
> サイト内の画像のように中心部分の拡大を2~3度繰り返すとサイト内の画像とはなんだか違う画像になりますが
> サイトの内容を理解しているわけでもないのであしからず。

移植に成功したJuliaプログラムでKidsが困っています。大半の関数形では正しく表示されるのですが、中には手ごわいものがあります。どうも次数が上がるとパターンがはっきりとでないのです。たとえば次の関数のジュリア集合の場合です。


LET Z=z^7+z^3+0.01/z

で上段の図が得られます。かなり薄くパターンが出ており、これはPhotoshopでもお手上げです。

Dr.MihaelBeckerによると下段のような明確なパターンであると主張しています。精度KSの問題でもないようです。白黒ラインでラインを強く出す方法は考えられませんか?
 

使い方を教えてください。

 投稿者:大熊 正  投稿日:2018年 2月 7日(水)18時55分11秒
返信・引用
  ?最初の画面 ファイル(F)の中にあるprogramらしきものの説明は、どこにあるのですか。

②自分で作ったprogramは、USERに入れるのですか。取扱説明書はどこですか。

③昔、XPで使ってたころ、PERT の10進数BASIC program が何処かにありました。
 同時に数値計算のプログラムも多数ありました。
 Windows10のパソコンを購入したので、そのWindows10 クロムでに調査、COPYしたいので
 すが、どうしたらよいですか。

④画面にZIPを解凍してできた、ショートカットは表示できました。昔やったうろ覚え
 の10進数BASICを再びやりたいのですが、出て来たこの画面や機能の説明はどこにある
 のでしょうか。取扱説明書はどこですか。
 

Re: PLOT TEXTのバグ?

 投稿者:白石 和夫  投稿日:2018年 2月 7日(水)12時25分55秒
返信・引用
  > No.4491[元記事へ]

NOTXORモードにすると文字の大きさが微妙に変化してしまうのが原因です。
SET TEXT HEIGHTを実行して適正なサイズに変えてみてください。

SET bitmap SIZE 101,101
SET WINDOW -1,1,-1,1
SET TEXT HEIGHT 0.4
SET DRAW mode notxor
PLOT TEXT,AT 0,0 :"A-B"
END


>
> アニメーション中で数字を表示していたところ、負の値なのにマイナスが表示されず、気が付きました。
>
> 環境
> OS:Microsoft Windows [Version 10.0.16299.192]
> 十進BASIC Version 7.8.2
>
> !===再現プログラム===
> SET bitmap SIZE 101,101
> SET WINDOW -1,1,-1,1
> SET DRAW mode notxor
> PLOT TEXT,AT 0,0 :"-" !ハイフンがなぜか表示されない!
> END
 

Re: notxorモードなのにplot label二度書きでも消えない?

 投稿者:白石 和夫  投稿日:2018年 2月 7日(水)12時13分47秒
返信・引用
  > No.4492[元記事へ]

細かいことをいうと面倒ですが,とりあえず仕様ということでご了承ください。

十進BASICヘルプより抜粋

以下の文は,画面上の色と描画に用いる色との混色の仕方を定める。
ただし,PLOT TEXT文以外による文字の描画には適用しない。
(DRAW GRID,DRAW AXESが描く文字にも適用されない)
SET DRAW MODE OVERWRITE
 指定された色で描く(上書きする)(標準の状態)。
SET DRAW MODE MASK
 減色混合を行う(黒の方向に向かう)。
SET DRAW MODE MERGE
 加色混合を行う(白の方向に向かう)。
SET DRAW MODE XOR
 黒地に描いたとき,指定された色で描く。
 このモードで二度書きすると,元の色に戻る。
SET DRAW MODE NOTXOR
 白地に描いたとき,指定された色で描く。
 このモードで二度描きすると,元の色に戻る。


> 下記のプログラムでは、notxorモードなので、「ABC」を二度書きすることで、最終的な画面には何も表示されません。これは、私の期待どおりの動作です。
> ところが、PLOT TEXTをPLOT LABELに(当然2行とも)変更すると、なぜか画面に「ABC」が表示されてしまいます。
> なぜ、PLOT LABELでは、notxorモードで二度書きしても消えてくれないのでしょうか?
>
> 環境
> OS:Microsoft Windows [Version 10.0.16299.192]
> 十進BASIC Version 7.8.2
>
> !===再現プログラム===
> SET bitmap SIZE 101,101
> SET WINDOW -1,1,-1,1
> SET DRAW mode notxor
> PLOT TEXT,AT 0,0 :"ABC"
> PLOT TEXT,AT 0,0 :"ABC"
> END
 

notxorモードなのにplot label二度書きでも消えない?

 投稿者:あおきたいち  投稿日:2018年 2月 6日(火)23時53分7秒
返信・引用
  下記のプログラムでは、notxorモードなので、「ABC」を二度書きすることで、最終的な画面には何も表示されません。これは、私の期待どおりの動作です。
ところが、PLOT TEXTをPLOT LABELに(当然2行とも)変更すると、なぜか画面に「ABC」が表示されてしまいます。
なぜ、PLOT LABELでは、notxorモードで二度書きしても消えてくれないのでしょうか?

環境
OS:Microsoft Windows [Version 10.0.16299.192]
十進BASIC Version 7.8.2

!===再現プログラム===
SET bitmap SIZE 101,101
SET WINDOW -1,1,-1,1
SET DRAW mode notxor
PLOT TEXT,AT 0,0 :"ABC"
PLOT TEXT,AT 0,0 :"ABC"
END
 

PLOT TEXTのバグ?

 投稿者:あおきたいち  投稿日:2018年 2月 6日(火)23時42分19秒
返信・引用
  バグ報告は、こちらの掲示板でよろしかったでしょうか?

下記のプログラムで、なぜか画面にハイフンが表示されません。
ただし、
・bitmap sizeが100,100なら表示されます。
・draw mode notxorをコメントアウトすれば、表示されます。
・plot text ではなく plot labelなら表示されます。

アニメーション中で数字を表示していたところ、負の値なのにマイナスが表示されず、気が付きました。

環境
OS:Microsoft Windows [Version 10.0.16299.192]
十進BASIC Version 7.8.2

!===再現プログラム===
SET bitmap SIZE 101,101
SET WINDOW -1,1,-1,1
SET DRAW mode notxor
PLOT TEXT,AT 0,0 :"-" !ハイフンがなぜか表示されない!
END
 

カラーパレット作成ツール

 投稿者:しばっち  投稿日:2018年 2月 6日(火)20時10分20秒
返信・引用
  カラーパレットを作成します。
まだまだ改良の余地はありますが、とりあえず動きます。汗( ̄◇ ̄;)

実行すると、カラーパレットが表示されます。
まず、設定したいパレットコード(0~255)をクリックして選択してください。

★「MODE 1」,「MODE 2」,「MODE 3」をクリック
   カラー選択用の画面が出ます。
   MODE 3では色の選択に画像ファイルを使用します。

   選択画面から登録したい色をクリックして選びます。
   なお、マウスカーソルがグラフィックウインドゥからはみ出した時は、
   スペシャルモードが発動しますのでクリックではなく、TABキーを押して選択してください。

   ★ 「登録」をクリック
      登録してコード設定に戻ります。
   ★ 「戻る」をクリック
   登録はせずにコード設定に戻ります。

★ 「終了」をクリック
   登録したコードのみを出力するか、問い合わせます。
      ★ 「YES」 で登録コードのみ出力して終了します。
      ★ 「NO」  で全色分出力するか、問い合わせます。
          ★ 「YES」 で全色分出力して終了。
          ★ 「NO」  で出力キャンセルして終了。

出力されたBASICコードはコピペして使用して下さい。


OPTION ARITHMETIC NATIVE
OPTION BASE 0
RANDOMIZE
PUBLIC NUMERIC FLG(255)
DIM R(255),G(255),B(255)
SET COLOR MODE "REGULAR"
FOR I=0 TO 255
   ASK COLOR MIX(I) R(I),G(I),B(I) !'パレット読み出し
   LET R(I)=INT(R(I)*255)
   LET G(I)=INT(G(I)*255)
   LET B(I)=INT(B(I)*255)
NEXT I
CALL GINIT(900,800)
DO
   CLEAR
   LET XSIZE=600
   LET YSIZE=500
   LET STY=INT(YSIZE/16)
   LET STX=INT(XSIZE/16)
   CALL DRAWPALLET(XSIZE,YSIZE,STX,STY,R,G,B) !'カラーパレットの描画
   LET X1=700
   LET Y1=30
   LET X2=850
   LET Y2=75
   LET DY1=70
   LET DY2=140
   CALL DRAWBOTTON(X1,Y1,X2,Y2,DY1, "MODE 1","MODE 2") !'ボタンを描く
   CALL DRAWBOTTON(X1,Y1+DY2,X2,Y2+DY2,70,"MODE 3","終 了")
   IF CODE=0 THEN
      LET X=STX
      LET Y=STY
   ELSE
      LET X=MOD(CODE,16)*STX+STX+5
      LET Y=INT(CODE/16)*STY+STY+5
   END IF
   DO
      IF X>=STX AND X<=STX+16*STX AND Y>=STY AND Y<=STY+16*STY THEN !'座標で振り分け
         LET CODE=INT((Y-STY)/STY)*16+INT((X-STX)/STX) !'設定用のコード
         CALL DRAWCOLORCODE(X,Y,STX,STY,CODE,R,G,B)
      ELSEIF X>X1 AND X<X2 AND Y>Y1 AND Y<Y2 THEN    !' MODE 1をクリック
         CALL  DRAWMODE(1,17*STX,17*STY,CODE,R,G,B)
         EXIT DO
      ELSEIF X>X1 AND X<X2 AND Y>Y1+DY1 AND Y<Y2+DY1 THEN   !' MODE 2をクリック
         CALL  DRAWMODE(2,17*STX,17*STY,CODE,R,G,B)
         EXIT DO
      ELSEIF X>X1 AND X<X2 AND Y>Y1+DY2 AND Y<Y2+DY2 THEN   !' MODE 3をクリック
         CALL DRAWMODE(3,17*STX,17*STY,CODE,R,G,B)
         EXIT DO
      ELSEIF X>X1 AND X<X2 AND Y>Y1+DY2+70 AND Y<Y2+DY2+70 THEN  !' 終了をクリック
         SELECT CASE CONFIRM$("登録のみ出力しますか?")
         CASE "YES"
            FOR I=0 TO 255
               IF FLG(I)<>0 THEN       !'登録したコードのみ
                  PRINT "SET COLOR MIX(";STR$(I);") ";STR$(R(I));"/255,";STR$(G(I));"/255,";STR$(B(I));"/255" !'BASICコード出力
               END IF
            NEXT I
         CASE "NO"
            SELECT CASE CONFIRM$("全色出力しますか?")
            CASE "YES"
               FOR I=0 TO 255
                  PRINT "SET COLOR MIX(";STR$(I);") ";STR$(R(I));"/255,";STR$(G(I));"/255,";STR$(B(I));"/255"
               NEXT I
            CASE "NO"
               CALL MESSAGEBOX("出力を取り消しました")
            END SELECT
         END SELECT
         STOP
      END IF
      DO
         MOUSE POLL X,Y,LL,RR
      LOOP UNTIL LL<>0 OR RR<>0 OR GETKEYSTATE(9)<0 !'クリックするかTABキーを押すまで待つ
      DO
         MOUSE POLL X,Y,LL,RR
      LOOP WHILE LL<>0 OR RR<>0 OR GETKEYSTATE(9)<0 !'指が離れるまで待つ
   LOOP
LOOP
END

EXTERNAL  SUB DRAWBOTTON(X1,Y1,X2,Y2,DY,A$,B$) !'ボタンを描く
OPTION ARITHMETIC NATIVE
CALL BOXFULL(X1,Y1,X2,Y2,128,128,128)
IF B$<>"" THEN CALL BOXFULL(X1,Y1+DY,X2,Y2+DY,128,128,128)
SET TEXT HEIGHT 38
SET TEXT COLOR COLORINDEX(0,0,0)
PLOT TEXT ,AT X1,Y1:A$
IF B$<>"" THEN PLOT TEXT ,AT X1,Y1+DY:B$
END SUB

EXTERNAL  SUB ERASEBOTTON(X1,Y1,X2,Y2,DY) !'ボタンを消す
OPTION ARITHMETIC NATIVE
CALL BOXFULL(X1,Y1,X2,Y2,255,255,255)
CALL BOXFULL(X1,Y1+DY,X2,Y2+DY,255,255,255)
END SUB

EXTERNAL  SUB DRAWCOLORCODE(X,Y,STX,STY,K,R(),G(),B()) !'コード情報出力
OPTION ARITHMETIC NATIVE
CALL BOXFULL(STX,540,899,799,255,255,255)
SET TEXT COLOR COLORINDEX(0,0,0)
SET TEXT HEIGHT 28
PLOT TEXT ,AT STX,540:"登録CODE:"&RIGHT$("0"&BSTR$(K,16),2)&"("&STR$(K)&")"
SET TEXT HEIGHT 26
PLOT TEXT ,AT STX,574:"R="&STR$(R(K))&" G="&STR$(G(K))&" B="&STR$(B(K))
CALL BOXFULL(STX,610,336,770,R(K),G(K),B(K))
IF FLG(K)<>0 THEN
   SET TEXT HEIGHT 45
   SET TEXT COLOR COLORINDEX(0,0,0)
   PLOT TEXT ,AT 415,650:"登録済"
ELSE
   SET TEXT HEIGHT 45
   SET TEXT COLOR COLORINDEX(0,0,0)
   PLOT TEXT ,AT 415,650:"未登録"
END IF
END SUB

EXTERNAL  SUB DRAWMODE(MODE,XSIZE,YSIZE,K,R(),G(),B()) !'MODE 1~3を処理
OPTION ARITHMETIC NATIVE
OPTION ANGLE DEGREES
LET X1=700
LET Y1=30
LET X2=850
LET Y2=75
LET DY1=70
LET DY2=140
CALL DRAWBOTTON(X1,Y1,X2,Y2,DY1,"登録","戻る")
CALL ERASEBOTTON(X1,Y1+DY2,X2,Y2+DY2,DY1)
SELECT CASE MODE !'モードにより色選択用の画面を描画する
CASE 1
   LET S=255
   FOR Y=0 TO YSIZE
      FOR X=0 TO XSIZE
         CALL HSV2RGB(INT(X/XSIZE*360),S,255-INT(Y/YSIZE*255),RR,GG,BB)
         CALL PSET(X,Y,RR,GG,BB)
      NEXT  X
   NEXT  Y
CASE 2
   LET V=255
   FOR Y=0 TO YSIZE
      FOR X=0 TO XSIZE
         IF X=INT(XSIZE/2) AND Y=INT(YSIZE/2) THEN LET H=0 ELSE  LET H=MOD(ANGLE(X-XSIZE/2,Y-YSIZE/2)+360,360)
         LET S=INT(SQR((X-XSIZE/2)^2+(Y-YSIZE/2)^2)/SQR((XSIZE/2)^2+(YSIZE/2)^2)*255)
         IF S>255 THEN LET S=255
         CALL HSV2RGB(H,S,V,RR,GG,BB)
         CALL PSET(X,Y,RR,GG,BB)
      NEXT  X
   NEXT  Y
CASE 3
   OPTION BASE 0
   LET XSIZE=600
   LET YSIZE=500
   LET STY=INT(YSIZE/16)
   LET STX=INT(XSIZE/16)
   FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG" !'画像ファイル読み込み
   IF N$="" THEN
      CALL MESSAGEBOX("キャンセルしました")
      EXIT SUB
   END IF
   GLOAD N$
   LET BIWIDTH=PIXELX(1)+1
   LET BIHEIGHT=PIXELY(1)+1
   SET BITMAP SIZE BIWIDTH,BIHEIGHT
   SET WINDOW 0,BIWIDTH-1,BIHEIGHT-1,0
   DIM VM(BIWIDTH,BIHEIGHT)
   ASK PIXEL ARRAY(0,0) VM
   CALL GINIT(900,800)
   CALL DRAWBOTTON(X1,Y1,X2,Y2,DY1,"登録","戻る")
   CALL DRAWCOLORCODE(STX,STY,STX,STY,K,R,G,B)
   FOR Y=0 TO YSIZE
      FOR X=0 TO XSIZE
         CALL BILINEAR(BIWIDTH,BIHEIGHT,X*BIWIDTH/XSIZE,Y*BIHEIGHT/YSIZE,VM,RR,GG,BB)
         CALL PSET(X,Y,RR,GG,BB)
      NEXT  X
   NEXT  Y
END SELECT
LET RR=-1
LET GG=-1
LET BB=-1
DO
   DO
      MOUSE POLL XX,YY,L1,R1    !'マウス操作
      IF SPECIAL=0 THEN CALL GETPOINT(XX,YY,R0,G0,B0) ELSE CALL GETCOLOR(R0,G0,B0)
      SET DRAW MODE HIDDEN
      SET TEXT HEIGHT 10
      CALL BOXFULL(740,670,899,690,255,255,255)
      SET TEXT COLOR COLORINDEX(0,0,0)
      PLOT TEXT ,AT 740,670:"(R,G,B)=("&USING$("###",R0)&","&USING$("###",G0)&","&USING$("###",B0)&")" !'カラーピッカー表示
      CALL BOXFULL(750,700,850,770,R0,G0,B0)
      SET DRAW MODE EXPLICIT
      CALL MOUSECURSOR(MX,MY)
      IF MX>=0 AND MX<=899 AND MY>=0 AND MY<=799 THEN LET SPECIAL=0 ELSE LET SPECIAL=1
   LOOP UNTIL L1<>0 OR R1<>0 OR GETKEYSTATE(9)<0          !'クリックするかTABキーを押す
   IF XX<=XSIZE AND YY<=YSIZE OR GETKEYSTATE(9)<0 THEN    !'座標で振り分け
      IF SPECIAL=0 THEN CALL GETPOINT(XX,YY,RR,GG,BB) ELSE CALL GETCOLOR(RR,GG,BB)
      SET TEXT COLOR COLORINDEX(0,0,0)
      SET TEXT HEIGHT 28
      PLOT TEXT ,AT 350,670:"→"
      CALL BOXFULL(400,572,770,603,255,255,255)
      SET TEXT COLOR COLORINDEX(0,0,0)
      SET TEXT HEIGHT 26
      PLOT TEXT ,AT 400,574:"R="&STR$(RR)&" G="&STR$(GG)&" B="&STR$(BB)
      CALL BOXFULL(400,610,700,770,RR,GG,BB)
   ELSEIF XX>X1 AND XX<X2 AND YY>Y1 AND YY<Y2 THEN !'登録ボタン処理
      IF RR>=0 AND GG>=0 AND BB>=0 THEN
         SELECT CASE CONFIRM$("登録しますか?")
         CASE "YES"
            LET R(K)=RR
            LET G(K)=GG
            LET B(K)=BB
            LET FLG(K)=1
            SET TEXT HEIGHT 30
            SET TEXT COLOR COLORINDEX(0,0,0)
            PLOT TEXT ,AT 650,440:"登録しました"
            WAIT DELAY 2
            EXIT DO
         CASE "NO"
            SET TEXT HEIGHT 20
            SET TEXT COLOR COLORINDEX(0,0,0)
            PLOT TEXT ,AT 650,440:"キャンセルしました"
            WAIT DELAY 2
            EXIT DO
         END SELECT
      ELSE
         CALL MESSAGEBOX("色が選択されていません")
      END IF
   ELSEIF XX>X1 AND XX<X2 AND YY>Y1+70 AND YY<Y2+70 THEN !'戻るボタン処理
      CALL MESSAGEBOX("キャンセルしました")
      EXIT DO
   END IF
   DO
      MOUSE POLL XX,YY,L1,R1
   LOOP WHILE L1<>0 OR R1<>0 OR GETKEYSTATE(9)<0 !'指が離れるまで待つ
LOOP
END SUB

EXTERNAL  SUB DRAWPALLET(XSIZE,YSIZE,STX,STY,R(),G(),B()) !'パレット描画
OPTION ARITHMETIC NATIVE
SET TEXT HEIGHT 16
SET TEXT COLOR COLORINDEX(0,0,0)
SET TEXT JUSTIFY "LEFT" , "TOP"
SET LINE WIDTH 3
FOR X=0 TO 15
   PLOT TEXT ,AT STX*1.2+X*STX,STY*.4:RIGHT$("0"&BSTR$(X,16),2)
NEXT X
FOR Y=0 TO 15
   PLOT TEXT ,AT STX*.4,STY*1.2+Y*STY:RIGHT$("0"&BSTR$(Y*16,16),2)
NEXT  Y
FOR Y=0 TO 15
   FOR X=0 TO 15
      LET K=INT(Y*16+X)
      CALL BOXFULL(X*STX+STX,Y*STY+STY,(X+1)*STX+STX,(Y+1)*STY+STY,R(K),G(K),B(K))
      IF FLG(K)<>0 THEN
         LET R0=INT(RND*256) !'色が被らないように
         LET G0=INT(RND*256)
         LET B0=INT(RND*256)
         CALL LINE(X*STX+STX,Y*STY+STY,(X+1)*STX+STX,(Y+1)*STY+STY,R0,G0,B0) !'登録済には×印
         CALL LINE((X+1)*STX+STX,Y*STY+STY,X*STX+STX,(Y+1)*STY+STY,R0,G0,B0)
      END IF
   NEXT X
NEXT Y
END SUB

EXTERNAL SUB HSV2RGB(H,S,V,R,G,B) !'HSVカラーをRGBカラーに変換
OPTION ARITHMETIC NATIVE
IF S=0 THEN
   LET R=V
   LET G=V
   LET B=V
   EXIT SUB
END IF
LET T=V-S*V/255
LET HH=H
IF H>=300 OR H<60 THEN
   IF H>=300 THEN LET HH=360-HH
   IF H<60 THEN LET HH=-HH
   LET HH=HH/60
   LET RR=0
   IF HH<0 THEN
      LET BB=1
      LET GG=HH+BB
   ELSE
      LET GG=1
      LET BB=GG-HH
   END IF
END IF
IF H>=60 AND H<180 THEN
   LET HH=HH-120
   LET HH=HH/60
   LET GG=0
   IF HH<0 THEN
      LET BB=1
      LET RR=HH+BB
   ELSE
      LET RR=1
      LET BB=RR-HH
   END IF
END IF
IF H>=180 AND H<300 THEN
   LET HH=HH-240
   LET HH=HH/60
   LET BB=0
   IF HH<0 THEN
      LET RR=1
      LET GG=HH+RR
   ELSE
      LET GG=1
      LET RR=GG-HH
   END IF
END IF
LET R=-RR*(V-T)+V
LET R=INT(R)
LET G=-GG*(V-T)+V
LET G=INT(G)
LET B=-BB*(V-T)+V
LET B=INT(B)
END SUB

EXTERNAL SUB BILINEAR(XSIZE,YSIZE,X,Y,IMAGE(,),R,G,B) !'バイリニア法
OPTION ARITHMETIC NATIVE
LET XX=X-INT(X)
LET YY=Y-INT(Y)
LET X0=INT(X)
LET Y0=INT(Y)
LET C1=IMAGE(X0,Y0)
IF X0+1<=XSIZE THEN LET C2=IMAGE(X0+1,Y0)
IF Y0+1<=YSIZE THEN LET C3=IMAGE(X0,Y0+1)
IF X0+1<=XSIZE AND Y0+1<=YSIZE THEN LET C4=IMAGE(X0+1,Y0+1)
CALL RGB(C1,R1,G1,B1)
CALL RGB(C2,R2,G2,B2)
CALL RGB(C3,R3,G3,B3)
CALL RGB(C4,R4,G4,B4)
LET R=(1-YY)*((1-XX)*R1+XX*R2)+YY*((1-XX)*R3+XX*R4)
LET G=(1-YY)*((1-XX)*G1+XX*G2)+YY*((1-XX)*G3+XX*G4)
LET B=(1-YY)*((1-XX)*B1+XX*B2)+YY*((1-XX)*B3+XX*B4)
LET R=MAX(0,MIN(255,R))
LET G=MAX(0,MIN(255,G))
LET B=MAX(0,MIN(255,B))
END SUB

EXTERNAL  SUB MESSAGEBOX(M$)
OPTION ARITHMETIC NATIVE
LET N=MESSBOX(0,M$,"BASIC",0)

FUNCTION MESSBOX(OWNER,TEXT$,CAPTION$,FLAG)
   ASSIGN "user32.dll","MessageBoxA"
END FUNCTION
END SUB

EXTERNAL  SUB MOUSECURSOR(MX,MY)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
LET  PNT$=REPEAT$("#",2*4)
LET  RC=GETCURSORPOS(PNT$)
LET  RC=SCREENTOCLIENT(WINHANDLE("GRAPHICS"),PNT$)
LET  MX=INT32(PNT$,0)
LET  MY=INT32(PNT$,4)
END SUB

EXTERNAL  SUB GETCOLOR(R,G,B)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
LET PNT$=REPEAT$("#",2*4)
LET RC=GETCURSORPOS(PNT$)
LET MX=INT32(PNT$,0)
LET MY=INT32(PNT$,4)
LET HDC=GETDC(0)
LET C=GETPIXEL(HDC,MX,MY)
LET DMY=RELEASEDC(0,HDC)
CALL RGB(C,R,G,B)
END SUB

EXTERNAL FUNCTION SCREENTOCLIENT(HWND, LPPOINT$)
OPTION ARITHMETIC NATIVE
ASSIGN "user32.dll" ,"ScreenToClient"
END FUNCTION

EXTERNAL FUNCTION GETCURSORPOS(LPPOINT$)
OPTION ARITHMETIC NATIVE
ASSIGN "user32.dll" ,"GetCursorPos"
END FUNCTION

EXTERNAL  FUNCTION GETPIXEL(HDC,X,Y)
OPTION ARITHMETIC NATIVE
ASSIGN "gdi32.dll" ,"GetPixel"
END FUNCTION

EXTERNAL  FUNCTION GETDC(HDC)
OPTION ARITHMETIC NATIVE
ASSIGN "user32.dll" ,"GetDC"
END FUNCTION

EXTERNAL  FUNCTION RELEASEDC(HWND,HDC)
OPTION ARITHMETIC NATIVE
ASSIGN "user32.dll" ,"ReleaseDC"
END FUNCTION

EXTERNAL FUNCTION INT32(S$,P)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
LET N=0
FOR I=1 TO 4
   LET N=N+256^(I-1)*ORD(S$(P+I:P+I))
NEXT I
IF N<2^31 THEN LET INT32=N ELSE LET INT32=N-2^32
END FUNCTION

EXTERNAL SUB RGB(X,R,G,B)
OPTION ARITHMETIC NATIVE
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
LET RR=MIN(255,MAX(0,INT(R)))
LET GG=MIN(255,MAX(0,INT(G)))
LET BB=MIN(255,MAX(0,INT(B)))
SET COLOR COLORINDEX(RR/255,GG/255,BB/255)
PLOT POINTS:X,Y
END SUB

EXTERNAL SUB BOX(XS,YS,XE,YE,R,G,B)
OPTION ARITHMETIC NATIVE
CALL LINE(XS,YS,XE,YS,R,G,B)
CALL LINE(XE,YS,XE,YE,R,G,B)
CALL LINE(XE,YE,XS,YE,R,G,B)
CALL LINE(XS,YE,XS,YS,R,G,B)
END SUB

EXTERNAL SUB LINE(X0,Y0,X1,Y1,R,G,B)
OPTION ARITHMETIC NATIVE
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT LINES:X0,Y0;X1,Y1
END SUB

EXTERNAL SUB GETPOINT(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB BOXFULL(X0,Y0,X1,Y1,R,G,B)
OPTION ARITHMETIC NATIVE
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT AREA:X0,Y0;X1,Y0;X1,Y1;X0,Y1;X0,Y0
END SUB
 

Re: マンデルブロート(ジュリア)

 投稿者:yoshipyuta  投稿日:2018年 2月 2日(金)10時46分50秒
返信・引用
  > No.4485[元記事へ]

しばっちさんへのお返事です。

> 上記サイト内にソースリストがありますので、とりあえず移植を試みてみました。
> しかしながら、この言語についての知識はなく、不明な点もありパラメータも不明なので
> サイト内の画像のように中心部分の拡大を2~3度繰り返すとサイト内の画像とはなんだか違う画像になりますが
> サイトの内容を理解しているわけでもないのであしからず。

しばっちさん、このプログラムはKidsにはかなり面白いようです。朝から晩までDR.Michel BeckerとともにJuliaの美しさに堪能のようですが探索はかなりむずかしそうです。

まずはC=complex(0.100,0.0700),LET Z=(Z^5-C*Z+0.09)/Z^3です。正に宇宙におけるRandom Walkです(上段の図)。但しプログラム出力図は見えにくいのでPhotoshopで色を変えています。

これをC=complex(0.0100,0.0702),LET Z=(Z^5-C*Z+0.09)/Z^3では何やら暗青色の海が見えてきます(中断の図)。

Tune-upすると超新星星雲のなかになんとDouadyのウサギが出現します。

 

Re: マンデルブロート(ジュリア)

 投稿者:yoshipyuta  投稿日:2018年 2月 2日(金)10時24分53秒
返信・引用
  しばっちさんへのお返事です。

>
> まず、COS(x)=0 の一般解 x=π/2+nπなのでxからπ/2を引いたものはπの倍数、つまりπで割り切れるので
>
> MOD(X-PI/2,PI)=0
>
> という式が出てきます。
> 但し、この時のX は複素数なのでこのままでは使えません。RE(X)やIM(X)関数を使い、許容誤差を含めて
>
> IF ABS(IM(X))<EPS AND ABS(MOD(RE(X)-PI/2,PI))<EPS THEN
>
> とすれば解決するかと思います。

懇切なご指導ありがとうございます。わがKidsは最新のしばっち・Juliaプログラム②に夢中です。

ご返事中の色の取り扱いが分からなくて(プログラム上で)、ガムシャラKidsはどうも安易に解を左右に16個並べて、この問題をスルーするらしいのです(下図、未完成)。

まあ、それはそれでプログラムを触ると様々なことが可能になるということが分かれば、ひとつの成果であります。
 

Re: マンデルブロート(ジュリア)

 投稿者:しばっち  投稿日:2018年 2月 1日(木)21時54分19秒
返信・引用
  > No.4486[元記事へ]

yoshipyutaさんへのお返事です。

> プログラムを手直しして、解を4つほど並べて解決と思ったらしい。
>
> LET Z1=COMPLEX(PI/2,0)
> LET Z2=COMPLEX(-PI/2,0)
> LET z3=COMPLEX(3*PI/2,0)
> LET z4=COMPLEX(-3*PI/2,0)
>
> EXTERNAL FUNCTION FUNC(X)
> OPTION ARITHMETIC COMPLEX
> LET FUNC=ccos(x)
> END FUNCTION
>
> ところが原点に近づくほど遠くのアトラクターの収束領域になるので、下図のようにのような黒領域になって正しく表示されません。すべての解nπ-π/2(n:整数)をLet文で並べるわけにもいかないので、どのように解決できますか?


まず、COS(x)=0 の一般解 x=π/2+nπなのでxからπ/2を引いたものはπの倍数、つまりπで割り切れるので

MOD(X-PI/2,PI)=0

という式が出てきます。
但し、この時のX は複素数なのでこのままでは使えません。RE(X)やIM(X)関数を使い、許容誤差を含めて

IF ABS(IM(X))<EPS AND ABS(MOD(RE(X)-PI/2,PI))<EPS THEN

とすれば解決するかと思います。
なお、色については、一般解のNを使うのがいいと思います。

N=(RE(X)-PI/2)/PI

このままではNが整数にならないかもしれないので

N=INT((RE(X)-PI/2)/PI+.5)

と四捨五入したほうがいいかもしれません。

このNの範囲については全くわかりませんが、例えば100色ならMOD(N,100)+1とすれば1~100までの色番号を使用します。
ただし、Nは負数の場合もあるはずなので絶対値をとって MOD(ABS(N),100)+1 とするか
補数を足して MOD(N+100,100)+1 のようにすればいいかと思います。
 

レンタル掲示板
/155