Yet Another Point 24

by Zhe Hu

Draw n numbers, group them with m operators, there are n!×(m^((n - 1)))×
        grouping_number[n]trials. For example, the standard Point 24 game, n = 4,  m = 4,  grouping_number[4] = 5, so there are 7680 trials. For Krypto, n = 5,  m = 4,  grouping_number[5] = 14, so there are 430080 trials.

Background

As discussed earlier, computer solutions of  Point 24, Krypto and other similar card games involve three key steps: permutation of the card numbers, permutation of the operators, groupings of the operators and the operands.

The first two steps are easy to do using Mathematica's Permutations[] and Outer[] functions. How can we make the groupings also automatic?

I happened to read Don Piele's Mathematica Pearls column. In Vol. 3, No. 2, Stan Wagon coded to solve another programming problem, but his code also solved the groupings (called bracketing there) elegantly by recursion.

Clear[h]
h[m_,  m_]  =  {m};
h[s_,  f_]  :=  h[s,  f]  = 
          Flatten[Table[
              Outer[F,  h[s,  i],  h[i  +  1,  f]],  {i,  s,  
                f  -  1}]]

Groupings for 4 card game, like Point 24

\(bracketings\  = \ \(#\  //. \ {a_?NumberQ\  :> \ ToString[a], 

              F[a_String, \ b_String]\  :> \ 
                StringJoin["(", \ a, \ " op ", \ 
                  b, \ ")"]}\  &\)\  /@ \ h[0, \ 3]\)

Groupings for 5 card game, like Krypto

\(bracketings\  = \ \(#\  //. \ {a_?NumberQ\  :> \ ToString[a], 

              F[a_String, \ b_String]\  :> \ 
                StringJoin["(", \ a, \ " op ", \ 
                  b, \ ")"]}\  &\)\  /@ \ h[0, \ 4]\)

Redo Point 24 from Stan Wagon's code

Stan Wagon's h-function is very elegant. I can't help redoing the Point 24 based on his code.

Modify Wagon's h-function a little bit, we get all 7680 trials

point24[{a_, b_, c_, d_}] := 
      Module[{h, temp}, h[m_, m_, num_] := {Part[num, m]}; 
        h[s_, f_, num_] := h[s, f, num] = 
            Flatten[Table[
                Outer[F,  {Plus,  Subtract,  Times, divide}, h[s, i, num], 
                  h[i + 1, f, num]], {i, s, f - 1}]]; 
        temp = Map[h[1, 4, #] &,  Permutations[{a, b, c, d}]] // 
            Flatten]

Short[point24[{2, 3, 4, 5}], 3]

Now complete the code by adding error detection: divide[ ], evaluation: actionF[ ], pretty print: printF[ ] as before.

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

point24[{a_, b_, c_, d_}] := 
      Module[{h, temp, actionF, printF}, h[m_, m_, num_] := {Part[num, m]}; 
        h[s_, f_, num_] := h[s, f, num] = 
            Flatten[Table[
                Outer[F,  {Plus,  Subtract,  Times, divide}, h[s, i, num], 
                  h[i + 1, f, num]], {i, s, f - 1}]]; 
        actionF[op_, n1_, n2_] := op[n1, n2]; 
        printF[op_, n1_, n2_] := 
          StringJoin["(", ToString[n1], 
            op /. {Times -> "×", divide -> "÷", 
                Plus -> "+", Subtract -> "-"}, 
            ToString[n2], ")"]; 
temp = 
          Map[h[1, 4, #] &,  Permutations[{a, b, c, d}]] // Flatten; 
        Map[# /. F -> printF &, 
          Select[temp,  (#  /.  F  ->  actionF)  ==  
                24  &]]]

point24[{2, 3, 4, 5}]

Redo Krypto from Stan Wagon's code

Since groupings become automatic, it's extremely easy to code Krypto from Point 24

krypto[{a1_, a2_, a3_, a4_, a5_, b_}] := 
      Module[{h, temp, actionF, printF}, h[m_, m_, num_] := {Part[num, m]}; 
        h[s_, f_, num_] := h[s, f, num] = 
            Flatten[Table[
                Outer[F,  {Plus,  Subtract,  Times, divide}, h[s, i, num], 
                  h[i + 1, f, num]], {i, s, f - 1}]]; 
        actionF[op_, n1_, n2_] := op[n1, n2]; 
        printF[op_, n1_, n2_] := 
          StringJoin["(", ToString[n1], 
            op /. {Times -> "×", divide -> "÷", 
                Plus -> "+", Subtract -> "-"}, 
            ToString[n2], ")"]; 
temp = 
          Map[h[1, 5, #] &,  Permutations[{a1, a2, a3, a4, a5}]] // Flatten; 
        Map[# /. F -> printF &, 
          Select[temp,  (#  /.  F  ->  actionF)  ==  
                b  &]]]

krypto[{7, 7, 7, 19, 19, 18}]

Discussion

Everything seems to fall together due to the automatic solution of groupings. Comparing with the previous solutions, these here get rid of the annoying unassociative operator problem (–,  ÷) and it can be easily extended to more cards and more operators. For example, for 6 cards, 7 operators, the search space size is 42×(7^5)×6!  = 508243680.

Links of Interest

Don Piele's Mathematica Pearls, Vol. 3, No. 2, http://oldweb.uwp.edu/academic/mathematics/pearls/pearl1.nb

Point 24 submission at MathSource, http://library.wolfram.com/infocenter/MathSource/5131/

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