柿×食う＝客 ④ 重複確認のタイミングを変えてスピードアップ

一昨日は、「かき×くう＝きゃく」のコードの簡素化に挑戦した。ところが、文字の重複確認をユーザー定義関数で外出ししたところ、極端に処理速度が落ちてしまった。
infoment.hatenablog.com
そこで今回は、原因調査も含めて、さらに汎用性を高めてみる。

といっても、問題の個所は直ぐに分かった。

変更前

1. 同じ数字が別の平仮名に宛てられていないか重複確認する。
2. 重複していないものだけ、掛け算をして結果確認する。

処理速度 ⇒ 43秒

変更後

1. とにかく全部掛け算して、結果確認する。
2. 掛け算の結果が成立するものについて、更に重複確認する。

処理速度 ⇒ 0.1秒

それにしても、ここまで結果に差が出るとは思わなかった。無駄な掛け算をさせないための工夫のつもりだったのだが、連想配列は思いのほか負荷が大きかったようだ（実際は、どうなのだろう？）。

Sub 算数パズル()

    Dim ET As ElapsedTime
    Set ET = New ElapsedTime
        ET.init ET_MsgBox, "0.0"
        
    Dim か As Long
    Dim き As Long
    Dim く As Long
    Dim う As Long
    Dim や As Long
    
    Dim 乗数 As Long
    Dim 被乗数 As Long
    Dim 答え As Long
    
    Dim 桁数 As Long
        桁数 = 5
    Dim iMin As Long
        iMin = 10 ^ (桁数 - 1)
    Dim iMax As Long
        iMax = 10 ^ 桁数 - 1
    
    Dim i As Long
    Dim j As Long
        For i = iMin To iMax
                j = j + 1
                か = Mid(i, 1, 1)
                き = Mid(i, 2, 1)
                く = Mid(i, 3, 1)
                う = Mid(i, 4, 1)
                や = Mid(i, 5, 1)
                If か <> 0 And き <> 0 And く <> 0 Then
                    乗数 = か * 10 + き
                    被乗数 = く * 10 + う
                    答え = き * 100 + や * 10 + く
                    If 乗数 * 被乗数 = 答え Then
                        If 重複確認(i, 桁数) = False Then
                        Debug.Print "か：" & か & vbNewLine & _
                               "き：" & き & vbNewLine & _
                               "く：" & く & vbNewLine & _
                               "う：" & う & vbNewLine & _
                               "や：" & や & vbNewLine
                        End If
                    End If
                End If
        Next
        Debug.Print j

End Sub

Function 重複確認(val As Long, 桁数 As Long) As Boolean
    Dim Dict As Dictionary
    Set Dict = New Dictionary
    
    Dim i As Long
    For i = 1 To 桁数
        If Dict.Exists(Mid(val, i, 1)) Then
            重複確認 = True
            Exit For
        Else
            Dict(Mid(val, i, 1)) = Mid(val, i, 1)
        End If
    Next
End Function

次いで、更に汎用性を持たせるためには、どうすれば良いだろうか。とりあえず、以下の情報を取得してみよう。

1. 一つ目の文字群は何か（例．かき）
2. 二つ目の文字群は何か（例．くう）
3. 三つ目の文字群は何か（例．きゃく）
4. この式は、四則演算のどれか（例．掛け算）
5. この式には、何個の数字が使われているか（例．５個）

これらについて、正規表現などを用いて情報を取得してみた。

Sub HogeTest()

    Dim Equation As String
        Equation = "かき×くう＝きゃく"
        
    Dim myReg As RegExp
    Set myReg = New RegExp
        myReg.Pattern = "(.+)([＋－×÷／])(.+)(＝)(.+)"
    
    Dim MatchCase As MatchCollection
    Dim mySubMatches As SubMatches
    
    Equation = StrConv(Equation, vbWide)
    If myReg.test(Equation) Then
        Set MatchCase = myReg.Execute(Equation)
        Set mySubMatches = MatchCase(0).SubMatches
    End If
    
    Dim Dict As Dictionary
    Set Dict = New Dictionary
    
    Dim i As Long
    Dim j As Long
    Dim s As String
        For i = 0 To 2
            For j = 1 To Len(mySubMatches(i))
                s = Mid(mySubMatches(i), j, 1)
                Dict(s) = s
            Next
        Next
    
    Dim myOperator As String
        Select Case mySubMatches(1)
            Case "＋": myOperator = "足し算です。"
            Case "－": myOperator = "引き算です。"
            Case "×": myOperator = "掛け算です。"
            Case "÷", "／": myOperator = "割り算です。"
        End Select
        
        For i = 0 To 4 Step 2
            Debug.Print i / 2 + 1 & "つ目の数字は" & mySubMatches(i) & "です。"
        Next
        Debug.Print "この計算は、" & myOperator
        Debug.Print "この式には、数字が" & UBound(Dict.Keys) + 1 & "個使われています。"

End Sub

結果は、↓ 以下のとおり。

さて、これをどう使おうか。

明日に続きます。

参考まで。