Revisit a Combinatorial Card Game
Point 24

by Zhe Hu

Given four numbers drawn from a set of poker cards, the intellectual challenge is to combine them with operators so that the result is 24.

((1 + 9)×2) + 
      4 "\n" ((4 - 1) + 9)×2 
        "\n" ((9 - 2) - 1)×4

Background

Someone raised this question about "Point 24" on MathGroup in year 2000. It is believed that children in China play this game to hone their arithmetic skills.  It is also true that even adults enjoy playing this game, and not only in China.

One version of the game is that two, or more people gather around a table, who would put out four cards by turns. Then everyone tries to reach 24 by combining these four numbers with operators \(TraditionalForm\`\((\(+\(\(,\)\(\ \)\(-\ ×\)\(,\)\(\ \)\(÷\)\)\))\)\). The one who gets the solution fastest would pat the table to announce it. If it's correct, he/she can collect the cards on the table. In the end, the winner collects all the cards from the others.

Discussions on MathGroup

The idea is to try all possible combinations of four numbers and operators: 
A x B y C z D 
Where A, B, C, D are in the set {1,  ... , 13} and x, y, z are in the set \(TraditionalForm\`{\(×\)\(\(,\)\(\ \)\(\(÷\)\(\(,\)\(\ \)\(+\(\(,\)\(\ \)\(-\)\)\)\)\)\)}\) (from Mike Yukish)
Since Mathematica can do permutations of four numbers, the groupings with operators becomes as simple as two possibilities, i.e.  x( y ( z (A, B), C), D) and x( y (A, B), z (C, D)) .
Here we use the prefix way to represent them assuming that you are familiar with Lisp or Mathematica. However operators like + and × are associative, so redundancy is inevitable.

One of the solutions from Roberto Brambilla <rlbrambilla at cesi.it> tried seven groupings, whereas two groupings are enough,

Below is a modified version of Roberto Brambilla's code, which uses for-loop and gives pretty print-out.

point24original[{n1_, n2_, n3_, n4_}] := 
      Module[{q, op, e1, e2}, 
        q = Map[ToString,  {n1, n2, n3, n4}] // Permutations; 
        op = {"+", "-", "*", "/"};   For[r = 1, 
          r <= Length[q], r++,  p = q[[r]];  
          For[i = 1, i <= 4, i++,  
            For[j = 1, 
              j <= 4, j++,  
For[k = 1, 
                k <= 4, k++,  
e1 = "(" <> 
                    p[[1]] <> op[[i]] <> p[[2]] <> ")" <> 
                    op[[j]] <> "(" <> p[[3]]  <> op[[k]] <> 
                    p[[4]] <> ")"; 
                If[ToExpression[e1] == 24, Print[e1]];  
                e2 = "(" <> "(" <> p[[1]] <> op[[i]] <> 
                    p[[2]] <> ")" <> op[[j]] <> 
                    p[[3]] <> ")" <> op[[k]]  <> 
                    p[[4]];    
If[ToExpression[e2] == 24, 
                  Print[e2]]; ]]]; ] ]

point24original[{1, 2, 4, 9}]

Another solution was by Will Self. It was quite functional, but missed the possibility of op ( op (n1,  n2),  
          op (n3,  n4)) and the print-out wasn't very pretty.

Below is a modified version based on Will Self's code.

f1[operations[h1_, h2_, h3_],  numbers[n1_, n2_, n3_, n4_]] := 
      h1[h2[h3[n1, n2], n3], n4]

f2[operations[h1_,  h2_,  h3_],  
          numbers[n1_,  n2_,  n3_,  n4_]]  :=  
        h1[h2[n1,  n2], h3[n3,  n4]]

cardSolution[{a_,  b_,  c_,  d_}]  :=  
        Module[{temp}, 
          temp = Flatten[ 
              Outer[use,  
                Flatten[
                  Outer[operations,  
                    Sequence  @@  
                      Table[{Plus,  Subtract,  Times,  
                          Divide},  {3}]]],  numbers  @@  #  &  /@  Permutations[{a,  b,  c,  d}]]]; {Select[
              temp,  (#  /.  use  ->  f1)  ==  24  &], 
            Select[temp, (# /. use -> f2) == 24 &]}]

cardSolution[{1, 3, 8, 8}]

Modifications and Extension

There is still room for improvements and extension.

Avoid Invalid Expression

As shown above, zero denominator is annoying for both Brambilla and Self's code. One can change operator "Divide" into a self-defined "div" with zero check.

div[x_?NumberQ, y_?NumberQ] = 
        If[y == 0, Null,  x/y];

Improve Print-Out

Learning from Brambilla's pretty print out, one can improve Self's code by adding

\(printf1[operations[h1_, h2_, h3_], numbers[n1_, n2_, n3_, n4_]] := 
      StringReplace["(" <> "(" <> ToString[n1] <> ToString[h3] <> 
          ToString[n2] <> ")" <> ToString[h2] <> ToString[n3] <> ")" <> 
          ToString[h1] <> 
          ToString[
            n4], {"Plus" -> "+", \ "Subtract" -> "-", \ "Times" -> "×", \ "div" -> "÷"}]\)

\(printf2[operations[h1_, h2_, h3_], numbers[n1_, n2_, n3_, n4_]] := 
      StringReplace["(" <> ToString[n1] <> ToString[h2] <> 
          ToString[n2] <> ")" <> ToString[h1] <> "(" <> ToString[n3] <> 
          ToString[h3] <> 
          ToString[
            n4] <> ")", {"Plus" -> "+", \ "Subtract" -> "-", \ "Times" -> "×", \ "div" -> "÷"}]\)

So the improved version becomes

cardSolution[{a_,  b_,  c_,  d_}]  :=  
        Module[{temp}, 
          temp = Flatten[ 
              Outer[use,  
                Flatten[
                  Outer[operations,  
                    Sequence  @@  
                      Table[{Plus,  Subtract,  Times,  
                          div},  {3}]]],  numbers  @@  #  &  /@  
                  Permutations[{a,  b,  c,  d}]]]; {Map[# /. 
                  use -> printf1 &, 
              Select[temp,  (#  /.  use  ->  f1)  ==  24  &]], 
            Map[# /. use -> printf2 &, 
              Select[temp, (# /. use -> f2) == 24 &]]}]

cardSolution[{1, 3, 8, 8}]

More Operators

It would be fun to extend the game by adding more operators to it, such as Log, Power, Binomial, Permutation. Below is a fully extended version of Point 24 based on the idea and codes from discussions on MathGroup.

Remove[f1, f2, bio, log, div, power, perm, printf1, printf2, 
      point24]

f1[operations[h1_, h2_, h3_],  numbers[n1_, n2_, n3_, n4_]] := 
        h1[h2[h3[n1, n2], n3], n4];

f2[operations[h1_,  h2_,  h3_],  
            numbers[n1_,  n2_,  n3_,  n4_]]  :=  
          h1[h2[n1,  n2], h3[n3,  n4]];

bio[x_Integer, y_Integer] = 
        If[x > y > 0, Binomial[x, y], Null];

log[x_?NumberQ, y_?NumberQ] = 
        If[x > 1 && y > 0, Log[x, y], Null];

div[x_?NumberQ, y_?NumberQ] = 
        If[y == 0, Null, x/y];

power[x_?NumberQ, y_?NumberQ] = 
      If[x == 0, Null, Power[x, y]];

perm[x_Integer, y_Integer] = 
        If[x > y > 0, bio[x, y] y!, Null];

\(printf1[operations[h1_, h2_, h3_], numbers[n1_, n2_, n3_, n4_]] := 
      StringReplace["(" <> "(" <> ToString[n1] <> ToString[h3] <> 
          ToString[n2] <> ")" <> ToString[h2] <> ToString[n3] <> ")" <> 
          ToString[h1] <> 
          ToString[
            n4], {"Plus" -> "+", \ "Subtract" -> "-", \ "Times" -> "×", \ "div" -> "÷", "log" -> " log ", "perm" -> " P ", "bio" -> " C ", \ "power" -> " ^ "}]\)

\(printf2[operations[h1_, h2_, h3_], numbers[n1_, n2_, n3_, n4_]] := 
      StringReplace["(" <> ToString[n1] <> ToString[h2] <> 
          ToString[n2] <> ")" <> ToString[h1] <> "(" <> ToString[n3] <> 
          ToString[h3] <> 
          ToString[
            n4] <> ")", {"Plus" -> "+", \ "Subtract" -> "-", \ "Times" -> "×", \ "div" -> "÷", "log" -> " log ", "perm" -> " P ", "bio" -> " C ", "power" -> " ^ "}]\)

point24[{a_, b_, c_, d_}] := 
      Module[{temp}, 
temp = 
          Flatten[ 
            Outer[use,  
              Flatten[Outer[operations,  
                  Sequence  @@  
                    Table[{Plus,  Subtract,  Times,  div, log, perm, bio, 
                        power},  {3}]]],  numbers  @@  #  &  /@  
                Permutations[{a,  b,  c,  d}]]]; {Map[# /. 
                use -> printf1 &, 
            Select[temp,  (#  /.  use  ->  f1)  ==  24  &]], 
          Map[# /. use -> printf2 &, 
            Select[temp, (# /. use -> f2) == 24 &]]}]

point24[{3, 2, 9, 6}]

Usually the "power" operator takes most of the time.  Leave it out if you are in a hurry.

Links of Interest

Point 24 game online, http://www-personal.umich.edu/~huahaiy/arith24/

Point 24 calculator, http://www.speedy7.com/calc24/index.html

Will Self's code, http://forums.wolfram.com/mathgroup/archive/2000/Nov/msg00017.html

Roberto Brambilla's code, http://forums.wolfram.com/mathgroup/archive/2000/Nov/msg00018.html

About the Author

Zhe Hu is pursuing his Ph. D. degree in biomedical engineering at Illinois Institute of Technology, Chicago, IL
huzhe@iit.edu
http://www.iit.edu/~huzhe