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

　先日、久しぶりに電車に乗っていたら、"3,4,7,8から10を作れ"と書いてある広告を見かけました。

　昔は切符に4つの数字が書いてあったのでよくやったものです。ICカードになってからは全然やらないですが。

　さておき。パズルを解く気分で少し解いてみました。プログラミングの勉強には比較的良い題材だと思います。

やることは4つの数字から2つ選んで四則演算。それを繰り返して10を作るだけです。

- 1回目の計算：順番を考慮して4つから2つ選ぶ方法は12通り

- 2回目の計算：1回目の計算結果と残りの2つから2つを選ぶ方法は6通り

- 3回目の計算：残っている数字を選ぶ方法は2通り

- 四則演算：4通り

よって、すべての組み合わせは、12 * 4 * 6 * 4 * 2 * 4 = 9216通りです。たかだか1万通りくらいです。Excel VBAでリストアップしてみましょう。

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

------------------------------

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 Calc10A(1, 1, 9, 9)

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

'a(0) - a(3)    :   0 - 9の数字4つ

'a(4)   :   1回目の演算結果

'a(5)   :   2回目の演算結果

'a(6)   :   3回目の演算結果

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

    '---------- 演算子選択のIndex ----------

    Dim i0 As Long

    Dim i1 As Long

    Dim i2 As Long

    

    '---------- 数字選択のIndex ----------

    Dim j0 As Long

    Dim j1 As Long

    Dim j2 As Long

    Dim j3 As Long

    Dim j4 As Long

    Dim j5 As Long

    

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

    Dim a(6) As Double

    

    a(0) = a0

    a(1) = a1

    a(2) = a2

    a(3) = a3

    a(4) = 0

    a(5) = 0

    a(6) = 0

    

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

    For i0 = 0 To 3

        For j0 = 0 To 3

            For j1 = 0 To 3

                If j1 <> j0 Then

                

                    a(4) = OperationCalc(i0, a(j0), a(j1))

                                      

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

                    For i1 = 0 To 3

                        For j2 = 0 To 4

                            If j2 <> j0 And j2 <> j1 Then

                                For j3 = 0 To 4

                                    If j3 <> j0 And j3 <> j1 And j3 <> j2 Then

                                    

                                        a(5) = OperationCalc(i1, a(j2), a(j3))

                                                            

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

                                        For i2 = 0 To 3

                                            For j4 = 0 To 5

                                                If j4 <> j0 And j4 <> j1 And j4 <> j2 And j4 <> j3 Then

                                                    For j5 = 0 To 5

                                                        If j5 <> j0 And j5 <> j1 And j5 <> j2 And j5 <> j3 And j5 <> j4 Then

                                                        

                                                            a(6) = OperationCalc(i2, a(j4), a(j5))

                                                            

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

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

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

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

                                                            col = col + 3

                                                            

                                                            If i0 = 3 And Math.Abs(a(j1)) < epsilon Then

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

                                                                GoTo label

                                                            End If

                                                                

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

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

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

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

                                                            col = col + 3

                                                            

                                                            If i1 = 3 And Math.Abs(a(j3)) < epsilon Then

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

                                                                GoTo label

                                                            End If

                                                            

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

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

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

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

                                                            col = col + 3

                                                            

                                                            If i2 = 3 And Math.Abs(a(j5)) < epsilon Then

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

                                                                GoTo label

                                                            End If

                                                            

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

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

label:

                                                            row = row + 1

                                                            col = 1

                                                        End If

                                                    Next j5

                                                End If

                                            Next j4

                                        Next i2

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

                                    End If

                                Next j3

                            End If

                        Next j2

                    Next i1

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

                End If

            Next j1

        Next j0

    Next i0

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

End Sub

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

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

　今回は、4つの数字の組み合わせ全てで計算してみます。

　0から9までの数字を4つ選ぶ方法は10000通りですが、順序の入れ替えを考慮すると715通りです(重複ありの組み合わせです)。715通りで10になるパターンを探すだけなので、計算は意外に重たくないです。

　今回は、再帰関数を使いませんでした。(ちなみに、再帰関数を使った場合、途中でループから抜けるのが、少し面倒です。)

　計算途中に小数が出てくる(3,4,7,8)(1,1,9,9)(1,3,3,7)のようなパターンは少し難しい感じです。

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

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

 Option Explicit

Dim row As Long

Dim col As Long

Const epsilon As Double = 0.000001

Public Sub Calc10All()

    Dim a0 As Long

    Dim a1 As Long

    Dim a2 As Long

    Dim a3 As Long

    

    Sheet1.Cells.Clear

    

    row = 1

    col = 1

    For a0 = 0 To 9

        For a1 = a0 To 9

            For a2 = a1 To 9

                For a3 = a2 To 9

                    Sheet1.Cells(row, col + 0) = a0

                    Sheet1.Cells(row, col + 1) = a1

                    Sheet1.Cells(row, col + 2) = a2

                    Sheet1.Cells(row, col + 3) = a3

                    col = col + 4

                    

                    Call Calc10All_iterate(a0, a1, a2, a3)

                    row = row + 1

                    col = 1

                Next a3

            Next a2

        Next a1

    Next a0

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 Sub Calc10All_iterate(a0 As Long, a1 As Long, a2 As Long, a3 As Long)

    '---------- 演算子選択のIndex ----------

    Dim i0 As Long

    Dim i1 As Long

    Dim i2 As Long

    

    '---------- 数字選択のIndex ----------

    Dim j0 As Long

    Dim j1 As Long

    Dim j2 As Long

    Dim j3 As Long

    Dim j4 As Long

    Dim j5 As Long

    

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

    Dim a(6) As Double

    

    a(0) = a0

    a(1) = a1

    a(2) = a2

    a(3) = a3

    a(4) = 0

    a(5) = 0

    a(6) = 0

    

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

    For i0 = 0 To 3

        For j0 = 0 To 3

            For j1 = 0 To 3

                If j1 = j0 Then

                    GoTo label0

                End If

                

                a(4) = OperationCalc(i0, a(j0), a(j1))

                                  

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

                For i1 = 0 To 3

                    For j2 = 0 To 4

                        If j2 = j0 Or j2 = j1 Then

                            GoTo label1

                        End If

                            

                        For j3 = 0 To 4

                            If j3 = j0 Or j3 = j1 Or j3 = j2 Then

                                GoTo label2

                            End If

                            

                            a(5) = OperationCalc(i1, a(j2), a(j3))

                                                

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

                            For i2 = 0 To 3

                                For j4 = 0 To 5

                                    If j4 = j0 Or j4 = j1 Or j4 = j2 Or j4 = j3 Then

                                        GoTo label3

                                    End If

                                    

                                    For j5 = 0 To 5

                                        If j5 = j0 Or j5 = j1 Or j5 = j2 Or j5 = j3 Or j5 = j4 Then

                                            GoTo label4

                                        End If

                                        

                                        a(6) = OperationCalc(i2, a(j4), a(j5))

                                        

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

                                        If Math.Abs(a(6) - 10) < epsilon Then

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

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

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

                                            col = col + 3

                                            

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

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

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

                                            col = col + 3

                                            

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

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

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

                                            col = col + 3

                                            

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

                                            

                                            Exit Sub

                                        End If

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

label4:

                                    Next j5

label3:

                                Next j4

                            Next i2

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

label2:

                        Next j3

label1:

                    Next j2

                Next i1

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

label0:

            Next j1

        Next j0

    Next i0

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

    Sheet1.Cells(row, 14) = "Not 10"

End Sub