等分された円周上の点を線で結んでみる ③ 次の素数を求める
昨日は64等分された円周上の点について、素数個飛ばしで線を結び、模様を作成することに挑戦した。
infoment.hatenablog.com
今日は、昨日の続きから。
先日から参考にさせてもらっているサイトによれば、分割数が64である場合、素数は31までを用いている。そこで今回は条件を以下のように設定してみた。
なお、上記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
結果が ↓ こちら。
綺麗ではあるが、そろそろ色の変化も欲しくなってきた。
ということで、次回に続きます。
参考まで。