ジュリア集合

で定義される複素数列において C を固定し、Zn の初期値を変化させ n → ∞ の極限で無限大に発散しないという条件を満たす複素数 Z 全体が作る集合、これがジュリア集合となります。

図中の黒い部分は収束域、周囲の色は無限大に発散する速さを表します。

ここでは、ジュリア集合の z_n を点 (x_n, y_n) に、c を点 (a, b) にそれぞれ置き代えて、

　　　Z_n = X_n + i Y_n　とすると
　　　Z_n+1 = Z_n² + C
　　　　　　= X_n² - Y_n² + i 2X_nY_n + a + ib

　　　なので、実数部、虚数部は、それぞれ
　　　X_n+1 = X_n² - Y_n² + a
　　　Y_n+1 = 2X_nY_n + b

終了条件

使用したVBAコード

色の設定

エクセルでの限界

シート構成

サンプル画像

ＶＢＡコード

変数定義部　VBAコード

Option Explicit

'-------------------------------------
' ジュリア集合
'
' 複素数の数列　Zn+1=Zn^2+C
'
' 　が発散する回数を複素平面での色として求める
'
' 　Z = X+iY 　C=a+ib （i 虚数単位）として
'
' 　実数　Xn+1 = Xn^2 - Yn^2 + a
' 　虚数　Yn+1 = 2*Xn*Yn + b
'
' 　の数列を計算する
'
'--------------------------------------

Dim Rng As Range        'セル範囲オブジェクト
Dim Selected As Range   '選択されている範囲

Dim 中止 As Boolean     '中止フラグ

'---------------------
' 初期値
'---------------------

'計算範囲

Dim C0x As Double ' < Julia >
Dim C0y As Double ' < Julia >

Const INIT_AMAX = 2#     '実数軸最大
Const INIT_AMIN = -2#   '　　最小
Const INIT_BMAX = 1.5   '虚数軸最大
Const INIT_BMIN = -1.5   '　　最小

'セル範囲
Dim CMax As Integer        '列最大
Dim CMin As Integer        '　最小
Dim RMax As Integer        '行最大
Dim RMin As Integer        '　最小
Dim RC_ratio As Double     '比

Dim xmax As Double, xmin As Double
Dim ymax As Double, ymin As Double

Dim cs As Integer, ce As Integer
Dim rs As Integer, re As Integer


Dim max_cnt As Long         '指定反復計算最大回数
Const MAX_CNT_LIMIT = 1000  '同上限

'------------------------------------
' 履歴
'------------------------------------
Private Type TYPE_HISTORY
    xmin As Double
    xmax As Double
    ymin As Double
    ymax As Double
    max_cnt As Long
    rs As Integer
    re As Integer
    cs As Integer
    ce As Integer
End Type

Dim History(1) As TYPE_HISTORY  '履歴

イベント処理　VBAコード

'------------------------------------
' イベント処理
'------------------------------------

Private Sub cmdStop_Click()     '中止
    中止 = True
End Sub


Private Sub cmdInit_Click() ' 初期状態に戻す
    Call Init                       '初期化
    Rng.Interior.Pattern = xlNone   'クリア
    Set Selected = Nothing              '未選択状態
    Range("XY").Value = GetXY       '計算範囲
    Range("MAG").Value = GetMag     '拡大率表示
    Call Go                         '開始
End Sub


Private Sub cmdReCal_Click()  '再計算
    Call Go
End Sub


Private Sub cmdBack_Click()
'
' 戻る
'
    Set Rng = Range("DATA")                 '描画域
    With History(1)
        xmin = .xmin: xmax = .xmax: ymin = .ymin: ymax = .ymax
        max_cnt = .max_cnt
        rs = .rs: re = .re: cs = .cs: ce = .ce
    End With
    cmbCalCount.Value = max_cnt
    cmdBack.Enabled = False

    
    Call Go '作成開始
    
    Range("DATA").Range("A1").Select 'セル選択

End Sub


Private Sub cmdMagnify_Click()
'
' 選択範囲を拡大
'
    Dim xs As Double, xe As Double
    Dim ys As Double, ye As Double
    Dim Lc As Double, Lr As Double
    Dim Lx As Double, Ly As Double

    Set Rng = Range("DATA")                 '描画域
    Rng.Interior.Pattern = xlNone   'クリア
    
    '-------------------------
    ' 選択範囲チェック
    '-------------------------
    Dim blErr As Boolean
    blErr = False
    If Selected Is Nothing Then '未選択
        blErr = True
    ElseIf Selected.Rows.Count + Selected.Columns.Count < 4 Then    '範囲不足
        blErr = True
    End If
    If blErr Then
        MsgBox "拡大範囲を選択して下さい！"
        Exit Sub
    End If
    '-------------------------
   
    If xmax = 0 And xmin = 0 Then Call Init    '範囲選択－未

    Lc = CMax - CMin + 1
    Lr = RMax - RMin + 1
    Lx = xmax - xmin
    Ly = ymax - ymin
    
    cs = Selected.Column - CMin             '選択セル 列開始
    ce = cs + Selected.Columns.Count - 1    '         列終わり
    
    rs = Selected.Row - RMin                '選択セル 行開始
    re = rs + (ce - cs) * RC_ratio          '　　　　 列幅にあわせる
    
    '------------------------------------
    ' 履歴
    '------------------------------------
    With History(1)
        .xmin = xmin: .xmax = xmax: .ymin = ymin: .ymax = ymax
        .max_cnt = max_cnt
        .rs = rs: .re = re: .cs = cs: .ce = ce
    End With
    '------------------------------------

    xmax = xmin + Lx * (ce - 1) / (Lc - 1)
    xmin = xmin + Lx * (cs - 1) / (Lc - 1)
    
    ymin = ymin + Ly * (rs - 1) / (Lr - 1)
    ymax = ymin + (xmax - xmin) * (INIT_BMAX - INIT_BMIN) / (INIT_AMAX - INIT_AMIN)
    

    cmdBack.Enabled = False  '「戻る」ボタン無効

    Call Go '作成開始
    
    cmdBack.Enabled = True  '「戻る」ボタン有効
    
End Sub


Private Sub cmdDetail_Click()
'
' 選択域を細密表示
'
    中止 = False

    With Selected
        Go_Sub .Row, .Row + .Rows.Count - 1, .Column, .Column + .Columns.Count - 1, 1 '解像度に応じて
        .Select
    End With
    
End Sub


Private Sub Worksheet_Activate()
    Call Init   '初期値
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)    '選択範囲が変更された
    
    Dim Data As Range

    Set Data = Range("DATA")
    Set Selected = Intersect(Target, Data)

    Dim Rng As Range
    Set Rng = Intersect(Target, Data)
    Application.StatusBar = GetMag(Rng) & "    " & _
                            GetSel(Rng) & "     " & _
                            GetXY(Rng)   '計算範囲、拡大率表示

End Sub

内部サブルーチン／関数　VBAコード

'////////////////////////////////////////////
'-----------------------------------------
' サブルーチン／関数
'-----------------------------------------

Private Sub Init()          '初期値設定
    Set Rng = Range("DATA")                 '描画域
    RMin = 1: RMax = Rng.Rows.Count         'セル行－開始／終了
    CMin = 1: CMax = Rng.Columns.Count      '　　列－開始／終了
    RC_ratio = (RMax - RMin) / (CMax - CMin) '行列数比
    xmax = INIT_AMAX: xmin = INIT_AMIN      '描画範囲　x軸　開始／終了
    ymax = INIT_BMAX: ymin = INIT_BMIN      '　　　　　y軸
End Sub

Private Sub Go(Optional Stp As Integer = 1)

    Set Rng = Range("DATA")                 '描画域
    Range("SELCEL").Value = GetSel(Selected)  '選択範囲
    Range("A2").Select      '描画エリアを未選択状態にする
    
    中止 = False

    Go_Sub RMin, RMax, CMin, CMax, 2 * lstResolution.ListIndex + 1 '解像度に応じて

End Sub

Private Sub Go_Sub(rrmin As Integer, rrmax As Integer, _
                   ccmin As Integer, ccmax As Integer, _
                   Optional Stp As Integer = 1)
'
' 作成開始
'
    Dim v As Double
    
    Dim r As Integer, c As Integer  '行、列
    Dim rrs As Integer, rre As Integer
    Dim ccs As Integer, cce As Integer
    
    Dim x As Double, y As Double

    Dim blColor As Boolean  '着色－描画時に有効


    Dim Color As Long

    
    cmdStop.Enabled = True  '中止ボタンを有効

    If xmax = 0 And xmin = 0 Then Call Init     '計算範囲未設定→初期化
    
    '---------------------------
    ' 可変値
    '---------------------------
    
    C0x = Val(Range("C0x")) ' < Julia >
    C0y = Val(Range("C0y")) ' < Julia >
    
    blColor = CBool(chkColor.Value)     '着色
    max_cnt = Val(cmbCalCount.Value)    '反復計算回数

    Range("MAG0").Value = GetMag0       '拡大率（前回比）
    Range("MAG").Value = GetMag         '拡大率

    Range("XY").Value = GetXY                   '計算範囲
    
    MyWait 100, 中止
    
    '--------------------------------------
    ' 解像度に応じて計算中心位置を決定
    '--------------------------------------
    Dim Span As Integer
    Span = (Stp + 1) / 2 - 1
    rrs = rrmin + Span: rre = rrmax - Span
    ccs = ccmin + Span: cce = ccmax - Span
    
    For r = rrs To rre - Span Step Stp

        For c = ccs To cce - Span Step Stp
        
            x = xmin + (xmax - xmin) * (c - CMin + 1) / (CMax - CMin + 1)
            y = ymin + (ymax - ymin) * (r - RMin + 1) / (RMax - RMin + 1)
            v = CalDivCout(x, y, C0x, C0y, max_cnt)     ' < Julia >

            '-------------------------------------
            ' 着色処理
            '-------------------------------------
            Color = 0   '黒
            If v < max_cnt Then '反復計算回数最大値より小さい場合
            
                If blColor Then '着色要？
                    Dim ColorBase As Long
                    ColorBase = RGB(100, 100, 100)
                    Color = ColorBase + (&HFFFFFF - ColorBase) * v / MAX_CNT_LIMIT   'カラー
                Else
                    v = 255 * (1 - v / max_cnt)             '白黒
                    Color = RGB(v, v, v)
                End If
            
            End If
            
            Rng.Range(Cells(r - Span, c - Span), Cells(r + Span, c + Span)).Interior.Color = Color
            '--------------------------------------

        Next c

        If 中止 Then Exit For
        Application.StatusBar = (r & "/" & RMax)    'ステータスバーに進行状況表示
        
        DoEvents

    Next r
    
    cmdStop.Enabled = False '中止ボタンを無効

End Sub


Private Function GetSel(Optional Target As Range) As String
'
' 選択セル
'
    Dim r0 As Integer, c0 As Integer, r As Integer, c As Integer
    Dim Data As Range
    
    Set Data = Range("DATA")
    
    With Target
        
        If Target Is Nothing Then
            
            cmdMagnify.Enabled = False  '選択域拡大　有効
            cmdDetail.Enabled = False   '　　　細密
            
            GetSel = RMin & "," & CMin & " - " & RMax & "," & CMax
        Else
            
            cmdMagnify.Enabled = True
            cmdDetail.Enabled = True
            
            r0 = Data.Row - 1: c0 = Data.Column - 1
            r = .Row - r0: c = .Column - c0
            GetSel = r & "," & c & " - " & _
                               (r + .Rows.Count - 1) & "," & (c + .Columns.Count - 1)   '選択セル
        End If
        
    End With
    
End Function


Private Function GetMag0(Optional Target As Range) As String
'
' 拡大率（前回比）
'
    Dim v As Double
    v = 0
    With History(1)
        If (.xmax <> .xmin) And (xmax <> xmin) Then
            v = (.xmax - .xmin) / (xmax - xmin)                '拡大率
        End If
    End With
    GetMag0 = ""
    If v >= 1 Then GetMag0 = Format(v, "x#,###")
    
End Function

Private Function GetMag(Optional Target As Range) As String
'
' 拡大率
'
    Dim XY As Range
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    
    Set XY = Range("XY")
    
    If Target Is Nothing Then
        x1 = xmin: x2 = xmax: y1 = ymin: y2 = ymax
    Else
        With Target
            Call CellToXY(.Row, .Column, x1, y1)
            Call CellToXY(.Row + .Rows.Count - 1, .Column + .Columns.Count - 1, x2, y2)
        End With
    End If

    If x1 <> x2 Then GetMag = _
            Format((INIT_AMAX - INIT_AMIN) / (x2 - x1), "x#,###")    '拡大率
End Function


Private Function GetXY(Optional Target As Range) As String
'
' 計算範囲
'
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    
    If Target Is Nothing Then
        x1 = xmin: x2 = xmax: y1 = ymin: y2 = ymax
    Else
        With Target
            Call CellToXY(.Row, .Column, x1, y1)
            Call CellToXY(.Row + .Rows.Count - 1, .Column + .Columns.Count - 1, x2, y2)
        End With
    End If
    
    GetXY = x1 & " , " & y1 & " : " & x2 & " , " & y2            '計算範囲

End Function


Private Function CellToXY(r As Integer, c As Integer, ByRef x As Double, ByRef y As Double)
'
' セル座標から計算座標を求める
'
' 　出力：x,y
        If CMax = 0 Then Exit Function
        x = xmin + (xmax - xmin) * (c - CMin) / (CMax - CMin)
        y = ymin + (ymax - ymin) * (r - RMin) / (RMax - RMin)
End Function

	マンデルブロ集合	ジュリア集合
漸化式	Z=Z²+C	Z=Z²+C
Cの値	複素平面上を変化させる	固定（外部から設定）
Zの初期値Z₀	0 + 0i に固定	複素平面上を変化させる
集合の特徴	フラクタル性、一個の塊	フラクタル性、一個の塊の場合とバラバラの場合がある

ジュリア集合（Julia set）

ジュリア集合（Julia set）とは

集合の計算手順

終了条件

使用したVBAコード

色の設定

エクセルでの限界

シート構成

サンプル画像

ＶＢＡコード

変数定義部　VBAコード

イベント処理　VBAコード

内部サブルーチン／関数　VBAコード

リンクリスト


０．原図	１．左のピンク枠内を拡大

ジュリア集合（Julia set）

ジュリア集合（Julia set）とは

集合の計算手順

終了条件

使用したVBAコード

色の設定

エクセルでの限界

シート構成

サンプル画像

ＶＢＡコード

変数定義部 VBAコード

イベント処理 VBAコード

内部サブルーチン／関数 VBAコード

リンクリスト

変数定義部　VBAコード

イベント処理　VBAコード

内部サブルーチン／関数　VBAコード