Category Archives: mathematica

Solving 24s, part iii: mod

I have shown how to comprehensively solve a game of 24s that allows just arithmetic, and how to expand that to allow powers, roots, and logarithms. Now we’re going to add the modulo (Mod) function.

If you’ve followed the methodology in parts i and ii, this is pretty simple stuff.

First, to our set of simplified function definitions, I add
mod[x_Integer?(# > 0 &), y_Integer?(-16 <= # <= 16 && # != 0 &)] := Mod[x, y]; mod[x__] := Indeterminate;

Then, our rule definition step looks like
rules = generateRules[{Times, Plus, Subtract, divide, power, root, log, mod}, 4];

We're up to 512 rules here, once redundant patterns are eliminated. The complexity increases exponentially with the number of operators allowed.

The good news is that Mod makes lots of hands solvable that wouldn't be otherwise. See, for example,

{3, 5, 5, 10} -> 5*5-Mod[10,3]
{5, 6, 7, 10} -> 6*Mod[7^10,5]
{5, 7, 7, 8} -> Mod[7^7,5]*8, and
{6, 7, 7, 9} -> 6*Mod[7*7,9]

In fact, allowing Mod as an operator increases the total number of solvable hands all the way to 619 out of 715.

The unsolvable hands that remain are
{{1, 1, 1, 1}, {1, 1, 1, 2}, {1, 1, 1, 3}, {1, 1, 1, 4}, {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, 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, 10}, {1, 1, 9, 9}, {1, 1, 9, 10}, {1, 1, 10, 10}, {1, 2, 2, 2}, {1, 2, 9, 10}, {1, 2, 10, 10}, {1, 4, 9, 9}, {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, 7, 9}, {2, 6, 7, 7}, {2, 7, 7, 7}, {2, 7, 7, 9}, {2, 7, 9, 9}, {2, 9, 9, 9}, {2, 9, 9, 10}, {2, 10, 10, 10}, {3, 3, 10, 10}, {3, 5, 7, 7}, {3, 10, 10, 10}, {4, 4, 9, 9}, {4, 7, 7, 9}, {4, 7, 7, 10}, {4, 9, 9, 9}, {5, 5, 5, 7}, {5, 5, 5, 8}, {5, 5, 5, 10}, {5, 5, 6, 10}, {5, 5, 7, 9}, {5, 7, 7, 7}, {5, 7, 9, 9}, {5, 8, 10, 10}, {5, 9, 9, 9}, {5, 10, 10, 10}, {6, 6, 6, 7}, {6, 6, 7, 7}, {6, 6, 7, 8}, {6, 7, 7, 7}, {6, 7, 7, 8}, {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, 9, 9}, {7, 8, 8, 8}, {7, 9, 9, 9}, {7, 9, 9, 10}, {7, 9, 10, 10}, {7, 10, 10, 10}, {8, 8, 8, 8}, {8, 8, 9, 9}, {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}}

Solving 24s, part ii: powers, roots, and logarithms

In my last post on this topic, I showed that 566 of 715 possible hands in the game of 24s could be solved with simple arithmetic. However in practice people don’t play with just those operators. In my experience, a normal game always includes powers, roots, and logarithms. The solution method used for arithmetics works just fine when expanded for these additional functions, though I chose to make some small modifications for the sake of efficiency.

First, I redefine the functions to remove some cases that are quite unlikely to produce 24s, and which would increase memory needs and processing time significantly if left in place. See the following, for example:


Off[General::"spell1"]; Off[General::"spell"];
power[x_?(# > 0 &), y_?(-16 <= # <= 16 &)] := x^y; power[x__] := Indeterminate; root[x_Integer?(# > 0 &), y_Integer?(-16 <= # <= 16 && # != 0 &)] := Power[x, (y)^-1]; root[x__] := Indeterminate; divide[x_, y_] /; y != 0 := Divide[x, y]; divide[x_, 0] := Indeterminate; log[x_?(# > 0 &), y_?(# > 0 &)] := Log[x, y];
log[x__] := Indeterminate;

We can then generate rules as in the arithmetic case but with

rules = generateRules[{Times, Plus, Subtract, divide, power, root, log}, 4];

and run legitCombos as before. The result? 595 hands are solvable, as opposed to the 566 we had before. hands that can be solved now, that couldn’t be solved before, include

{1,1,8,9} -> 8 Root[9,1+1] and trivial variations
{1,2,9,9} -> (9-1) Root[9,2] and trivial variations
{2, 2, 2, 6} -> 2^(2+Log[2,6]) or (2*Root[6,2])^2 and trivial variations
{2,2,9,9} -> 2(Root[9,2]+9) and trivial variations
{3,7,8,10} -> 7 Root[8,3] +10 and trivial variations
{3,4,9,10} -> 4+Log[3,9]*10 and trivial variations
{7, 8, 9, 9} -> 8 Root[9,9-7] and trivial variations, and
{8, 8, 9, 10} -> 8 Root[9,10-8] and trivial variations.

The hands that remain unsolvable are

{{1, 1, 1, 1}, {1, 1, 1, 2}, {1, 1, 1, 3}, {1, 1, 1, 4}, {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, 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, 10}, {1, 1, 9, 9}, {1, 1, 9, 10}, {1, 1, 10, 10}, {1, 2, 2, 2}, {1, 2, 9, 10}, {1, 2, 10, 10}, {1, 4, 9, 9}, {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, 7, 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, 10, 10}, {3, 4, 6, 7}, {3, 5, 5, 10}, {3, 5, 7, 7}, {3, 5, 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, 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, 10, 10}, {6, 7, 7, 7}, {6, 7, 7, 8}, {6, 7, 7, 9}, {6, 7, 8, 8}, {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, 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, 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}}.

Next chapter, we add Mod[].

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.

Solving 24s

I am a fan of the mathematical card game “24s”, in which four cards are turned over simultaneously, and all the players search for ways to make the number 24 by combining the four numbers shown with any mathematical operators they like (I have always played with addition, subtraction, multiplication, division, powers, roots, and logarithms, but the list can be made longer or shorter depending on the preferences and mathematical skill of the players). The number on every card must be used, and no card can be used more than once. Face cards are pulled from the deck before playing and aces == 1. Suits don’t matter for the game; the deck is being used only as a random number generator.

The game is addictively fun, combining elements of math, pattern recognition, and memory. I learned the game in high school, and used to play with expedition-mates when climbing high mountains, to test for loss of mental acuity at altitude. Recently, I’ve been teaching my daughter how to play. She does pretty well!

Solutions are possible for most hands (about 83% of hands, for the normal rule set, by my computation), and in most solvable cases, more than one solution is possible. In case of a tie, cards can be distributed back to the players, or victory can be given to the newest player, or to the person who came up with the most solutions, or the most interesting solution.

Take for example the hand 2,3,10,10.

hand of cards

Two solutions are possible. The “easy” one is

(10-3)*2+10=24

But the more impressive one, remembered decades later who saw it played, is

2^10-10^3=24

I mention this game because I recently realized that the game is solvable, and that so long as you restrict yourself to binary operators, it is possible to determine absolutely which hands can be turned into 24 and which can’t, and how many solutions are possible for each hand, and what those solutions are.

I’ll discuss my method in future posts.

Mathematica and MySQL Server

I often use Mathematica and MySQL together; it’s typically a lot more efficient than trying to keep megabytes of data in the Mathematica notebook itself, and becomes vastly more powerful if I want to use the same data from multiple machines, all of which can tap into the same database.

Mathematica supports these uses natively, and you can send arbitrary SQL code to the server with the SQLExecute command. Interestingly, Mathematica also provides commands that map to major SQL commands, including SQLSelect[] and SQLInsert[]. I have never used these, viewing it as easier to program SQL commands in SQL itself, tuning them in MySQL Workbench.

Today, it occurred to me that Mathematica’s built-in commands might somehow be quicker than sending raw SQL, and I tested this hypothesis. Surprisingly, it turns out to be the case, with results similar to the following for a number of cases.


In[1]:= Needs["DatabaseLink`"]

In[2]:= commodDB = OpenSQLConnection[JDBC["MySQL(Connector/J)", "localhost:3306/commoddb"],
Username -> "myUsername", Password -> "myPassword"];

In[3]:= Timing[
SQLSelect[commodDB, "tbcommodprices", {"date", "ticker", "price"},
SQLColumn["ticker"] == "LAV08 Comdty" && SQLColumn["whichprice"] == "last"];]

Out[3]= {0.031, Null}

In[4]:= Timing[
SQLExecute[commodDB, "SELECT date, ticker, price FROM `commoddb`.`tbcommodprices` where ticker='LAV09 Comdty' and whichprice='last'"];]

Out[4]= {0.047, Null}

(The two queries differ slightly because I did not want caching to give an advantage to the second query).