Anonymous user
24 game/Solve: Difference between revisions
Mathematica (this was fun to write!)
m (→{{header|Ruby}}: validate user input) |
(Mathematica (this was fun to write!)) |
||
Line 6:
C.F: [[Arithmetic Evaluator]]
=={{header|Mathematica}}==
The code:
<lang Mathematica>
treeR[n_] := Table[o[trees[a], trees[n - a]], {a, 1, n - 1}]
treeR[1] := n
tree[n_] :=
Flatten[treeR[n] //. {o[a_List, b_] :> (o[#, b] & /@ a),
o[a_, b_List] :> (o[a, #] & /@ b)}]
game24play[val_List] :=
Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}],
"-1*" ~~ n_ :> "-" <> n] & /@ (HoldForm /@
Select[Union@
Flatten[Outer[# /. {o[q_Integer] :> #2[[q]],
n[q_] :> #3[[q]]} &,
Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@
tree[4], Tuples[{Plus, Subtract, Times, Divide}, 3],
Permutations[Array[v, 4]], 1]],
Quiet[(# /. v[q_] :> val[[q]]) == 24] &] /.
Table[v[q] -> val[[q]], {q, 4}])]</lang>
The <code>treeR</code> method recursively computes all possible operator trees for a certain number of inputs. It does this by tabling all combinations of distributions of inputs across the possible values. (For example, <code>treeR[4]</code> is allotted 4 inputs, so it returns <code>{o[treeR[3],treeR[1]],o[treeR[2],treeR[2]],o[treeR[1],treeR[3]]}</code>, where <code>o</code> is the operator (generic at this point). The base case <code>treeR[1]</code> returns <code>n</code> (the input). The final output of <code>tree[4]</code> (the 24 game has 4 random inputs) (<code>tree</code> cleans up the output of <code>treeR</code>) is:
<lang Mathematica>
{o[n, o[n, o[n, n]]],
o[n, o[o[n, n], n]],
o[o[n, n], o[n, n]],
o[o[n, o[n, n]], n],
o[o[o[n, n], n], n]}</lang>
<code>game24play</code> takes the four random numbers as input and does the following (the <code><font color=red>%</font></code> refers to code output from previous bullets):
*<code>Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@ tree[4]</code>
** Assign ascending numbers to the input and operator placeholders.
** Ex: <code>o[1][o[2][n[1], n[2]], o[3][n[3], n[4]]]</code>
*<code>Tuples[{Plus, Subtract, Times, Divide}, 3]</code>
** Find all combinations (<code>Tuples</code> allows repeats) of the four allowed operations.
** Ex: <code>{{Plus, Plus, Plus}, {Plus, Plus, Subtract}, <<60>>, {Divide, Divide, Times}, {Divide, Divide, Divide}}</code>
*<code>Permutations[Array[v, 4]]</code>
** Find all permutations (<code>Permutations</code> does not allow repeats) of the four given values.
** Ex: <code>{{v[1],v[2],v[3],v[4]}, {v[1],v[2],v[4],v[3]}, <<20>>, {v[4],v[3],v[1],v[2]}, {v[4],v[3],v[2],v[1]}}</code>
*<code>Outer[# /. <nowiki>{o[q_Integer] :> #2[[q]], n[q_] :> #3[[q]]}</nowiki> &, <font color=red>%%%</font>, <font color=red>%%</font>, <font color=red>%</font>, 1]</code>
** Perform an outer join on the three above lists (every combination of each element) and with each combination put into the first (the operator tree) the second (the operation at each level) and the third (the value ''indexes'', not actual values).
** Ex: <code>v[1] + v[2] - v[3] + v[4]</code>
*<code>Union@Flatten[<font color=red>%</font>]</code>
** Get rid of any sublists caused by <code>Outer</code> and remove any duplicates (<code>Union</code>).
*<code>Select[<font color=red>%</font>, Quiet[<nowiki>(# /. v[q_] :> val[[q]])</nowiki> == 24] &]</code>
** Select the elements of the above list where substituting the real values returns 24 (and do it <code>Quiet</code>ly because of div-0 concerns).
*<code>HoldForm /@ <font color=red>%</font> /. <nowiki>Table[v[q] -> val[[q]], {q, 4}]</nowiki></code>
** Apply <code>HoldForm</code> so that substituting numbers will not cause evaluation (otherwise it would only ever return lists like <code>{24, 24, 24}</code>!) and substitute the numbers in.
*<code>Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}], "-1*" ~~ n_ :> "-" <> n] & /@ <font color=red>%</font>]</code>
**For each result, turn the expression into a string (for easy manipulation), strip the "<code>HoldForm</code>" wrapper, replace numbers like "-1*7" with "-7" (a idiosyncrasy of the conversion process), and remove any lingering duplicates. Some duplicates will still remain, notably constructs like "3 - 3" vs. "-3 + 3" and trivially similar expressions like "(8*3)*(6-5)" vs "(8*3)/(6-5)". Example run input and outputs:
<lang Mathematica>RandomInteger[{1, 9}, 4]
game24play[%]</lang>
<lang Mathematica>{7, 2, 9, 5}
{-2 - 9 + 7*5}</lang>
<lang Mathematica>{7, 5, 6, 2}
{6*(7 - 5 + 2), (7 - 5)*6*2, 7 + 5 + 6*2}</lang>
<lang Mathematica>{7, 6, 7, 7}
{}</lang>
<lang Mathematica>{3, 7, 6, 1}
{(-3 + 6)*(7 + 1), ((-3 + 7)*6)/1, (-3 + 7)*6*1,
6 - 3*(-7 + 1), 6*(-3 + 7*1), 6*(-3 + 7/1),
6 + 3*(7 - 1), 6*(7 - 3*1), 6*(7 - 3/1), 7 + 3*6 - 1}</lang>
Note that although this program is designed to be extensible to higher numbers of inputs, the largest working set in the program (the output of the <code>Outer</code> function can get very large:
*<code>tree[n]</code> returns a list with the length being the (n-1)-th [[wp:Catalan number|Catalan number]].
*<code>Tuples[{Plus, Subtract, Times, Divide}, 3]</code> has fixed length 64 (or ''p<sup>3</sup>'' for ''p'' operations).
*<code>Permutations[Array[v, n]]</code> returns <math>n!</math> permutations.
Therefore, the size of the working set is <math>64 \cdot n!\, C_{n-1} = 64 \cdot (n-1)!!!! = 64 \frac{(2n-2)!}{(n-1)!}</math>, where <math>n!!!!</math> is the [[wp:quadruple factorial|quadruple factorial]]. It goes without saying that this number increases very fast. For this game, the total is 7680 elements. For higher numbers of inputs, it is {7 680, 107 520, 1 935 360, 42 577 920, 1 107 025 920, ...}.
=={{header|Python}}==
| |||