素因数のセットを取得するFunciton

素因数のセットを取得するFunction

前二回

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

の集大成として、素因数のセットを取得するメソッドを作ってみた。

コード

モジュールごとコードを載っけておく。

リスト1 標準モジュール
Option Explicit

Private Const MAX_NUMBER As Long = (2 ^ 31) - 1
Private Const OVER_FLOW_NUMBER As String = _
  "引数が大きすぎます。"
Private Const NOT_NATURAL_NUMBER As String = _
  "引数は自然数でなければいけません。"

'///素因数のセットを配列にして返す'
Public Function getFactorizatedNumbers( _
            ByVal targetNumber As Long) As Long()
  '引数が不正だったらエラーを吐く'
  Call raiseErrorIfInvalidArg(targetNumber)
  Dim ret() As Long
  Dim n As Long
  n = 0
  ReDim ret(n)
  '1だったらreturn'
  If targetNumber = 1 Then _
    ret(n) = targetNumber: GoTo Finalizer
  '素数だったらreturn'
  If isPrimeNumber(targetNumber) Then _
    ret(n) = targetNumber: GoTo Finalizer
  '素因数を配列化'
  Dim tmp As Long
  tmp = targetNumber
  Dim primeNumber As Long
  primeNumber = 2
  'tmpが素数になるまでループ'
  Do While Not isPrimeNumber(tmp)
    '素数で割り切れたら、その素数を配列に入れ、tmpを素数で割った商'
    'にして、次のループへ'
    If tmp Mod primeNumber = 0 Then
      ret(n) = primeNumber
      n = n + 1
      ReDim Preserve ret(n)
      tmp = tmp / primeNumber
      GoTo Continue
    End If
    '割り切れなかったら次の素数をセット'
    primeNumber = getNextPrimeNumber(primeNumber)
Continue: DoEvents
  Loop
  ret(n) = tmp
Finalizer:
  getFactorizatedNumbers = ret
End Function

'///素数かどうかを判定する'
Public Function isPrimeNumber( _
            ByVal targetNumber As Long) As Boolean
  isPrimeNumber = False
  '引数が不正だったらエラーを吐く'
  Call raiseErrorIfInvalidArg(targetNumber)
  '1だったらFalse'
  If targetNumber = 1 Then Exit Function
  '2だったらTrue'
  If targetNumber = 2 Then GoTo Finalizer
  '中央の値までループして合成数判定'
  Dim turningPoint As Long
  'ループするのは平方根の近似値までで良い'
  turningPoint = Int(Sqr(targetNumber))
  Dim i As Long
  For i = 2 To turningPoint
    If targetNumber Mod i = 0 Then
'      Debug.Print i & "で割り切れる。"'
      Exit Function
    End If
  Next
Finalizer:
  isPrimeNumber = True
End Function

'次の素数を取得する'
Private Function getNextPrimeNumber( _
             ByVal targetNumber As Long) As Long
  Dim ret As Long
  ret = targetNumber + 1
  Do While Not isPrimeNumber(ret)
    ret = ret + 1
  Loop
  getNextPrimeNumber = ret
End Function

'///引数不正時にエラーを吐く'
Private Sub raiseErrorIfInvalidArg( _
              ByVal targetNumber As Long)
  '1よりも小さな数字を受け取ったらエラーを吐く'
  If targetNumber < 1 Then _
    Call Err.Raise(Number:=10001, _
                   Source:="Arg is not natural number.", _
                   Description:=NOT_NATURAL_NUMBER)
  'オーバーフローする場合エラーを吐く'
  If targetNumber > MAX_NUMBER Then _
    Call Err.Raise(Number:=10002, _
                   Source:="Arg will be over flow.", _
                   Description:=OVER_FLOW_NUMBER)
End Sub

処理の手順は、コメントに記したとおり。

VBAには、ループ処理にcontinueがないので、擬似的にcontinueを実現しようとすると無理が出る。

上掲コード中だと、Doループが

  Do While Not isPrimeNumber(tmp)
    '素数で割り切れたら、その素数を配列に入れ、tmpを素数で割った商'
    'にして、次のループへ'
    If tmp Mod primeNumber = 0 Then
      ret(n) = primeNumber
      n = n + 1
      ReDim Preserve ret(n)
      tmp = tmp / primeNumber
      GoTo Continue
    End If
    '割り切れなかったら次の素数をセット'
    primeNumber = getNextPrimeNumber(primeNumber)
Continue: DoEvents
  Loop

こうなる。ラベルにGoToすることで、continueっぽくしているけれど、Continueがラベルである以上、インデントが崩れてしまう。

もちろん、上掲の場合ならElseを使えばいいのだけれど、Elseはなるべく使いたくないので……(可読性が落ちる。)。

実験

次のような実験用コードを準備。

スト2 標準モジュール
Private Sub testGetFactorizedNumbers( _
              ByVal targetNumber As Long)
  '引数targetNumberの素因数セットを取得して配列化'
  Dim ar() As Long
  ar = getFactorizatedNumbers(targetNumber)
  '配列の要素を一つづつ取り出して「*」でつなぐ'
  Dim i As Long
  Dim str As String
  For i = LBound(ar) To UBound(ar)
    str = str & CStr(ar(i)) & " * "
  Next
  '右端の余分な文字列を除去'
  str = Left(str, Len(str) - 3)
  'イミディエイトに表示'
  Debug.Print CStr(targetNumber) & " = " & str
End Sub

このtestGetFactorizedNumbersにテキトーな引数を渡して実行。

f:id:akashi_keirin:20190601210644j:plain

うまくいっている。

おわりに

あいかわらず、仕事の役に立ちそうにはありません。

頭の体操。