Excelで二個の平方数の和を求める - Infomentのブログ～Excel VBA奮闘記～

前回は、Excelで素因数分解をやってみた。
infoment.hatenablog.com
なぜ、素因数分解をやってみたか。そもそもの切っ掛けは、こちらの動画を
見たことだった。
※再生すると音が出るので、ご注意ください。
youtu.be

合成数が２つの平方数の和で表される条件は、
４で割ると３余る素因数が全て平方である

というわけで、やってみた。
f:id:Infoment:20220311223146p:plain

まず、動画同様「二個の平方数の和」をWikipediaで調べてみた。
ja.wikipedia.org
どうやら「フェルマーの二平方定理」を満たせば、二個の平方数の和を持つと
言えるらしい。

そこでまず、同定理を満たすか否かを返す関数を作ってみた。この中で使用する
PrimeFactorDictについては、前回分を参照してほしい。

' フェルマーの二平方定理に該当するか否か。
Function IsFermatsTwoSquareTheorem(num As Long) As Boolean
    Dim Dict As Object
    Set Dict = PrimeFactorDict(num)
    
    Dim myKey As Variant
        For Each myKey In Dict.Keys
            If myKey Mod 4 = 3 Then
                If WorksheetFunction.IsOdd(Dict(myKey)) Then
                    Exit Function
                End If
            End If
        Next
        
        IsFermatsTwoSquareTheorem = True
End Function

これでFalseが返れば、そもそも二個の平方数の和ではないということに。
Trueが返る場合のみ、地道に計算することにした。

例えば「20」で考える。

20 － 1^2＝19　←　√19は整数ではない。
20 － 2^2＝16　←　√16＝4
20 － 2^3＝12　←　√12は整数ではない。

のように評価していく。となると、計算結果が整数か否かを判別する関数が
欲しくなる。作ってみた。

' ある値が整数であるか否かの判定。
Function IsIntegralValue(num As Double) As Boolean
    If num - WorksheetFunction.RoundDown(num, 0) = 0 Then
        IsIntegralValue = True
    End If
End Function

あとは、先程の理屈をコード化するだけだ。

' 二個の平方数の和を求める関数。
Function GetTwoSquareNumber(num As Long) As Variant
    Dim arr As Variant
        arr = Array()
        If Not IsFermatsTwoSquareTheorem(num) Then
            GetTwoSquareNumber = arr
            Exit Function
        End If
    
    Dim i As Long
    Dim j As Long
        Do
            j = num - i ^ 2
            If j < 0 Then
                Exit Do
            ElseIf IsIntegralValue(j ^ 0.5) Then
                If i <= j ^ 0.5 Then
                    ReDim Preserve arr(UBound(arr) + 1)
                    arr(UBound(arr)) = Array(i, j ^ 0.5)
                Else
                    Exit Do
                End If
            End If
            
            i = i + 1
        Loop
        
        GetTwoSquareNumber = arr
End Function

この関数は答えを配列で返しているので、文字列で解り易く返してみよう。

Function 二個の平方数の和(num As Long) As String
    Dim arr As Variant
        arr = GetTwoSquareNumber(num)
        If UBound(arr) = -1 Then
            二個の平方数の和 = "解無し"
            Exit Function
        End If
        
    Dim i As Long
    Dim temp() As Variant
    ReDim temp(UBound(arr))
        For i = 0 To UBound(arr)
            temp(i) = arr(i)(0) & "と" & arr(i)(1)
        Next
        
        二個の平方数の和 = Join(temp, "，")
End Function