素因数のセットを取得するFunciton
素因数のセットを取得するFunction
前二回
の集大成として、素因数のセットを取得するメソッドを作ってみた。
コード
モジュールごとコードを載っけておく。
リスト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
にテキトーな引数を渡して実行。
うまくいっている。
おわりに
あいかわらず、仕事の役に立ちそうにはありません。
頭の体操。