Solving 24s, part i: Algebraic programming, arithmetic allowed

If the game of 24s is played with binary operators only, there is a finite number of different possible ways to combine the cards. Given a modern computer, it is perfectly solvable. The basic technique that I use is called algebraic programming, and amounts to combining every possible combination of four cards and every one of the permitted operators in every possible way, then selecting the combinations that equal 24.

This can be done in any programming language, but it’s natural in Mathematica, which natively supports the set operations on which this method relies.

First, some observations:

1. We have four cards, each of which can be any number from 1 to 10. We therefore have 10*10*10*10 (10,000) possible hands, if order matters.

2. If order doesn’t matter, such that {1,2,3,4} is the same as {4,3,2,1}, there are only 715 possible combinations

In[]:= Length[Union[Sort /@ Tuples[Range[10], 4]]]
Out[]= 715

Now we develop our combinations. This can be made easier using Andrzej Kozlowski’s “ReplaceAllList” function from The Mathematica Journal 9:2 © 2004.

ReplaceAllList[expr_, rules_] :=
Module[{i},
Join[ReplaceList[expr, rules],
If[AtomQ[expr], {},
Join @@ Table[
ReplacePart[expr, #, i] & /@
ReplaceAllList[expr[[i]], rules], {i, Length[expr]}]]]]

We have a choice — make our function set commutative, so that {3,2} is processed as both 3-2 and 2-3, or make our card set comprehensive, so that both arrangements are passed through the function. I elected the latter, but the former should work equally well.

Start by finding all the ways of associating four elements.

ClearAll[f]; SetAttributes[f, {Flat, OneIdentity}]; rawFunctions =
Union[FixedPoint[Union[Flatten[ReplaceAllList[#, f[a_, b_] -> g[a, b]]]] &,
f[a, b, c, d]] /. f -> g];

Off[General::"spell1"]; Off[General::"spell"];
divide[x_, y_] /; y != 0 := Divide[x, y]; divide[x_, 0] := Indeterminate;

Then we remove all duplicates and expressions that involve the application of g to three elements.

uniqueFunctions =
DeleteCases[rawFunctions, _?(Not[FreeQ[#, g[x__ /; Length[{x}] >= 3]]] &),
1];

Finally we replace g by Subscript[A, 2],Subscript[A, 1],Subscript[A, 0], in this order, and swap in the numbers from a hand of cards

functionsWNumbers[hands_List] :=
Map[(i = 0;
MapAll[If[# === g, # /. g -> Subscript[A, Mod[++i, 3]], #] &,
uniqueFunctions, Heads -> True] /. {a -> #[[1]], b -> #[[2]],
c -> #[[3]], d -> #[[4]]}) &, hands]

The following step generates every possible combination of operators. For four binary functions and four cards, we have a maximum of three functions per hand and only 64 possible combinations.

generateRules[binaryFunctions_List, numCards_Integer] :=
Module[{raw, refined, numFuncs},
numFuncs = Length[binaryFunctions];
raw = Map[Thread,
Map[RuleDelayed[Array[Subscript[A, # - 1] &, {numFuncs}], #] &,
Distribute[Array[binaryFunctions &, {numFuncs}], List]]];

(* since an actual hand never involves more than three binary operations,
we remove the rules involving unnecessary As.*)

refined = Union[DeleteCases[raw,Apply[Alternatives,
Map[HoldPattern[#] &,
Table[Subscript[A, i] :> _, {i, numCards - 1, numFuncs - 1}]]],
Infinity]];
refined]

Now we map our selected functions over the generic rules from the previous step.

generateHands[functions_List, rules_List] :=
Table[Union[# /. rules] & /@ functions[[i]], {i, 1, Length[functions]}]

When we get our answers, {1,1,2,2} is treated as distinct from {2,2,1,1}. Let’s fix that. The following assumes the cardSet is a single list of four integers {1,1,2,3}, and that the possibilitySet is a list of {{ordered four cards},{solutions}} like
{{6,6,6,6},{((6+6)+6)+6,(6+(6+6))+6,(6+6)+(6+6),6+((6+6)+6),6+(6+(6+6)),6 6-(6+6),(6 6-6)-6}}

solutionsForSet[cardSet_List, possibilitySet_List] :=
Module[{allVarieties, matches},
allVarieties = Permutations[cardSet];
matches = Select[possibilitySet, MemberQ[allVarieties, #[[1]]] &];
Flatten[matches[[All, 2]], 1]]

So, what do we find? Running every possible hand of cards through our 64 possible rules, and seeing which come out equal to 24, we find 566 of the 715 possible hands (about 79% of all possible cases) are solvable with arithmetic alone.

The unsolvable hands are {{1, 1, 1, 1}, {1, 1, 1, 2}, {1, 1, 1, 3}, {1, 1, 1, 4}, {1, 1, 1, 5}, {1, 1, 1, 6}, {1, 1, 1, 7}, {1, 1, 1, 9}, {1, 1, 1, 10}, {1, 1, 2, 2}, {1, 1, 2, 3}, {1, 1, 2, 4}, {1, 1, 2, 5}, {1, 1, 3, 3}, {1, 1, 5, 9}, {1, 1, 5, 10}, {1, 1, 6, 7}, {1, 1, 6, 10}, {1, 1, 7, 7}, {1, 1, 7, 8}, {1, 1, 7, 9}, {1, 1, 8, 9}, {1, 1, 8, 10}, {1, 1, 9, 9}, {1, 1, 9, 10}, {1, 1, 10, 10}, {1, 2, 2, 2}, {1, 2, 2, 3}, {1, 2, 9, 9}, {1, 2, 9, 10}, {1, 2, 10, 10}, {1, 3, 5, 5}, {1, 4, 7, 10}, {1, 4, 8, 10}, {1, 4, 9, 9}, {1, 5, 5, 7}, {1, 5, 5, 8}, {1, 5, 7, 7}, {1, 6, 6, 7}, {1, 6, 7, 7}, {1, 6, 7, 8}, {1, 6, 10, 10}, {1, 7, 7, 7}, {1, 7, 7, 8}, {1, 7, 10, 10}, {1, 8, 9, 9}, {1, 8, 9, 10}, {1, 8, 10, 10}, {1, 9, 9, 9}, {1, 9, 9, 10}, {1, 9, 10, 10}, {1, 10, 10, 10}, {2, 2, 2, 2}, {2, 2, 2, 6}, {2, 2, 7, 9}, {2, 2, 9, 9}, {2, 3, 3, 4}, {2, 5, 5, 5}, {2, 5, 5, 6}, {2, 5, 9, 9}, {2, 6, 7, 7}, {2, 7, 7, 7}, {2, 7, 7, 9}, {2, 7, 8, 10}, {2, 7, 9, 9}, {2, 9, 9, 9}, {2, 9, 9, 10}, {2, 10, 10, 10}, {3, 3, 4, 10}, {3, 3, 5, 8}, {3, 3, 7, 10}, {3, 3, 10, 10}, {3, 4, 6, 7}, {3, 4, 8, 8}, {3, 4, 9, 10}, {3, 5, 5, 5}, {3, 5, 5, 10}, {3, 5, 7, 7}, {3, 5, 8, 10}, {3, 7, 8, 10}, {3, 10, 10, 10}, {4, 4, 5, 9}, {4, 4, 6, 6}, {4, 4, 6, 7}, {4, 4, 9, 9}, {4, 4, 9, 10}, {4, 7, 7, 9}, {4, 7, 7, 10}, {4, 9, 9, 9}, {4, 9, 10, 10}, {4, 10, 10, 10}, {5, 5, 5, 7}, {5, 5, 5, 8}, {5, 5, 5, 10}, {5, 5, 6, 9}, {5, 5,
6, 10}, {5, 5, 7, 9}, {5, 6, 7, 10}, {5, 7, 7, 7}, {5, 7, 7, 8}, {5, 7, 9, 9}, {5, 8, 9, 9}, {5, 8, 9, 10}, {5, 8, 10, 10}, {5, 9, 9, 9}, {5, 9, 9, 10}, {5, 10, 10, 10}, {6, 6, 6, 7}, {6, 6, 7, 7}, {6, 6, 7, 8}, {6, 6, 9, 9}, {6, 6, 10, 10}, {6, 7, 7, 7}, {6, 7, 7, 8}, {6, 7, 7, 9}, {6, 7, 8, 8}, {6, 7, 9, 10}, {6, 8, 10, 10}, {6, 9, 9, 9}, {6, 9, 10, 10}, {7, 7, 7, 7}, {7, 7, 7, 8}, {7, 7, 7, 9}, {7, 7, 7, 10}, {7, 7, 8, 8}, {7, 7, 8, 9}, {7, 7, 8, 10}, {7, 7, 9, 9}, {7, 7, 10, 10}, {7, 8, 8, 8}, {7, 8, 9, 9}, {7, 9, 9, 9}, {7, 9, 9, 10}, {7, 9, 10, 10}, {7, 10, 10, 10}, {8, 8, 8, 8}, {8, 8, 8, 9}, {8, 8, 9, 9}, {8, 8, 9, 10}, {8, 8, 10, 10}, {8, 9, 9, 9}, {8, 9, 9, 10}, {8, 9, 10, 10}, {8, 10, 10, 10}, {9, 9, 9, 9}, {9, 9, 9, 10}, {9, 9, 10, 10}, {9, 10, 10, 10}, {10, 10, 10, 10}}

These same methods can be used with larger number of functions too, as I will show in coming posts.

3 thoughts on “Solving 24s, part i: Algebraic programming, arithmetic allowed

  1. Pingback: Solving 24s, part ii: powers, roots, and logarithms | monkeywrench

  2. Pingback: Solving 24s, part ii: mod | monkeywrench

  3. Pingback: A perfect solution to 24s | monkeywrench

Comments are closed.