等分された円周上の点を線で結んでみる ③ 次の素数を求める

昨日は64等分された円周上の点について、素数個飛ばしで線を結び、模様を作成することに挑戦した。
infoment.hatenablog.com

今日は、昨日の続きから。
f:id:Infoment:20200513202131j:plain

先日から参考にさせてもらっているサイトによれば、分割数が64である場合、素数は31までを用いている。そこで今回は条件を以下のように設定してみた。

  1. 開始する素数は3とする。
  2. 5,7,11と、「用いた素数」の「次に大きい素数」を用い繰り返し描画。
  3. 素数が分割数の1/2を超えた時点で、描画を中断する。

なお、上記2のために、今回は引数の次に大きい素数を返す関数を作成してみた。

' numより大きい最初の素数を返す。
Function NextPrimeNumber(num As Long) As Long
    Do
        num = num + 1
        If 素数判定(num) Then
            NextPrimeNumber = num
            Exit Function
        End If
    Loop
End Function

' numが素数ならば、Trueを返す。
' 素数でないならば、Falseを返す。
Function 素数判定(num As Long) As Boolean
    Dim i As Long
        If num <= 1 Then
            素数判定 = False
        ElseIf num = 2 Then
            素数判定 = True
        Else
            For i = 2 To WorksheetFunction.RoundUp(num ^ 0.5, 0)
                If num Mod i = 0 Then
                    素数判定 = False
                    Exit Function
                End If
            Next
            素数判定 = True
        End If
End Function

これを用いて、昨日の関数と合わせて描画する関数が ↓ こちら。

Sub PrimeMandara(prime_number As Long, _
        Optional wait_flag As Boolean = False)
    Dim 始点 As Long: 始点 = 1
    Dim 終点 As Long: 終点 = 1
    Dim 各座標 As Variant
        各座標 = 各座標取得
    
        Do
            始点 = 終点
            終点 = ((始点 + prime_number - 1) Mod 分割数) + 1
    
            ActiveSheet.Shapes.AddConnector msoConnectorStraight, _
                                            各座標(始点)(x座標), 各座標(始点)(y座標), _
                                            各座標(終点)(x座標), 各座標(終点)(y座標)
    
            If wait_flag Then
                Application.Wait [Now() + "00:00:00.1"]
            End If
            
            If 終点 = 1 Then Exit Do
        Loop
End Sub

Sub RegularPrimeMandara(Optional division_count As Long = 64, _
                        Optional reset_flag As Boolean = True)
    Dim Max As Long
    
    ' 描画に使用する最初の素数。
    Dim num As Long: num = 3
        If reset_flag Then
            Call Reset
        End If
    
    ' 分割数が4以下の場合、強制的に5とする。
    ' ※この場合、5つの頂点を持つ星が描画される。
        If division_count <= 4 Then
            division_count = 5
        End If
    
    ' 分割点を飛ばす個数(素数)がMaxを超えた時点で、処理を中断する。
    ' Maxは、最大値の半分(小数点切り上げ)とする。
        分割数 = division_count
        Max = WorksheetFunction.RoundUp(分割数 / 2, 0)
        
        Do
            PrimeMandara num
            num = NextPrimeNumber(num)
            
            If num >= Max Then
                Exit Do
            End If
        Loop
End Sub

それでは、実験してみよう。分割数を一つずつ変化させると時間が掛かるので、
今回は20~64までを4個飛ばしでやってみた。

Sub test()
    Dim i As Long
    With New Mandara
        For i = 20 To 64 Step 4
            .RegularPrimeMandara i
            Range("E6") = i
        Next
    End With
End Sub


結果が ↓ こちら。
f:id:Infoment:20200513203220g:plain

綺麗ではあるが、そろそろ色の変化も欲しくなってきた。

ということで、次回に続きます。

参考まで。