2021年12月5日日曜日

4つの数字で10を作るアレ その2

  前回作成したマクロは、ループの書き方がカッコ悪い感じです。再帰関数を使って、少し見やすくしてみます。

 ついでに無駄な計算を少し省略します。以下の2つは省略可能です。

- 四則演算のうち、足し算と掛け算は可換なので半分は不要

- 1回目の計算と2回目の計算が交換できる場合も半分は不要


 ソースコードはご自由にご利用ください。ただし、趣味のプログラムなので保証はありません。

'------------------------------

Option Explicit


Dim row As Long

Dim col As Long


Const epsilon As Double = 0.000001




Public Sub Calc10()

    Sheet1.Cells.Clear

    

    row = 1

    col = 1

    

    Call Calc10B(3, 4, 7, 8)

End Sub


'演算子の表示
Public Function OperationText(op As Long) As String
    OperationText = ""
    
    If op = 0 Then
        OperationText = "'+"
    ElseIf op = 1 Then
        OperationText = "'-"
    ElseIf op = 2 Then
        OperationText = "'*"
    ElseIf op = 3 Then
        OperationText = "'/"
    End If
End Function

'演算
Public Function OperationCalc(op As Long, a0 As Double, a1 As Double) As Double
    OperationCalc = a0
    
    If op = 0 Then
        OperationCalc = a0 + a1
    ElseIf op = 1 Then
        OperationCalc = a0 - a1
    ElseIf op = 2 Then
        OperationCalc = a0 * a1
    ElseIf op = 3 Then
        If Math.Abs(a1) < epsilon Then
            OperationCalc = a0
        Else
            OperationCalc = a0 / a1
        End If
    End If
End Function


'再帰関数を使う場合

Public Sub Calc10B(a0 As Long, a1 As Long, a2 As Long, a3 As Long)

    Dim a(6) As Double

    Dim op(2) As Long   '演算子のIndex

    Dim nm(5) As Long   '数字のIndex

    

    a(0) = a0

    a(1) = a1

    a(2) = a2

    a(3) = a3

    a(4) = 0

    a(5) = 0

    a(6) = 0

    

    Call Calc10B_iterate(a, op, nm, 0)

End Sub


Public Sub Calc10B_iterate(ByRef a() As Double, ByRef op() As Long, ByRef nm() As Long, cnt As Long)

    Dim i As Long

    Dim j As Long

    Dim k As Long

    Dim l As Long

    

    If cnt < 3 Then

        '----- Operator -----

        For i = 0 To 3

            op(cnt) = i

            

            '----- 1st number -----

            For j = 0 To 3 + cnt

                For l = 0 To 2 * cnt - 1

                    If j = nm(l) Then

                        Exit For

                    End If

                Next l

            

                If l <> 2 * cnt Then

                    GoTo label0

                End If

                

                nm(l) = j

                    

                '----- 2nd number -----

                For k = 0 To 3 + cnt

                    For l = 0 To 2 * cnt

                        If k = nm(l) Then

                            Exit For

                        End If

                    Next l

                    

                    If l <> 2 * cnt + 1 Then

                        GoTo label1

                    End If

                    

                    nm(l) = k

                    

                    '演算子が交換可能なとき

                    If (i = 0 Or i = 2) And k < j Then

                        GoTo label1

                    End If

                    

                    '1回目の演算と2回目の演算が交換可能なとき

                    '((a0,a1),(a2,a3)), ((a0,a2),(a1,a3)), ((a0,a3),(a1,a2)) の組み合わせは計算する

                    '((a1,a2),(a0+a3)), ((a1,a3),(a0,a2)), ((a2,a3),(a0,a1)) の組み合わせは計算しない

                    If cnt = 1 Then

                        If (j = 0 And (k = 1 Or k = 2 Or k = 3)) _

                        Or ((j = 1 Or j = 2 Or j = 3) And k = 0) Then

                            GoTo label1

                        End If

                    End If

                    

                    '----- Operation -----

                    a(4 + cnt) = OperationCalc(i, a(j), a(k))

                    

                    '----------

                    Call Calc10B_iterate(a, op, nm, cnt + 1)

label1:

                Next k

                '----------

label0:

            Next j

            '----------

        Next i

        '----------

    ElseIf cnt = 3 Then

        Call Calc10B_result(a, op, nm)

    End If

End Sub


Public Sub Calc10B_result(ByRef a() As Double, ByRef op() As Long, ByRef nm() As Long)

        '---------- 1回目の演算 ----------

        Sheet1.Cells(row, col + 0) = OperationText(op(0))

        Sheet1.Cells(row, col + 1) = a(nm(0))

        Sheet1.Cells(row, col + 2) = a(nm(1))

        col = col + 3

        

        If op(0) = 3 And Math.Abs(a(nm(1))) < epsilon Then

            Sheet1.Cells(row, col) = "Divided by Zero"

            GoTo label

        End If

        

        '---------- 2回目の演算 ----------

        Sheet1.Cells(row, col + 0) = OperationText(op(1))

        Sheet1.Cells(row, col + 1) = a(nm(2))

        Sheet1.Cells(row, col + 2) = a(nm(3))

        col = col + 3

        

        If op(1) = 3 And Math.Abs(a(nm(3))) < epsilon Then

            Sheet1.Cells(row, col) = "Divided by Zero"

            GoTo label

        End If

        

        '---------- 3回目の演算 ----------

        Sheet1.Cells(row, col + 0) = OperationText(op(2))

        Sheet1.Cells(row, col + 1) = a(nm(4))

        Sheet1.Cells(row, col + 2) = a(nm(5))

        col = col + 3

        

        If op(2) = 3 And Math.Abs(a(nm(5))) < epsilon Then

            Sheet1.Cells(row, col) = "Divided by Zero"

            GoTo label

        End If

        

        '------------------------------

        Sheet1.Cells(row, col) = a(6)

label:

        row = row + 1

        col = 1

End Sub


0 件のコメント:

コメントを投稿