CODEWITHSUNDEEP
mathwolfram-mathematicawolfram-language
Jason Roell
Jason Roell

Reputation: 6819

How to formulate this simple mathematical riddle in Wolfram Language

I'm trying to formulate the below question into a computable wolfram language solution, but can't seem to get it right.

Question:

Place three piles of matches on a table, one with 11 matches, the second with 7, and the third with 6. You are to move matches so that each pile holds 8 matches. You may add to any pile only as many matches as it already contains, and all the matches must come from one other pile. For example, if a pile holds 6 matches, you may add 6 to it, no more or less. You have three moves.

What I've tried:

"input": "pile1 = 11; pile2 = 7; pile3 = 6; moves = 3; findSolution[pile1_, pile2_, pile3_, moves_] := Module[{solutions}, solutions = FindInstance[{pile1 + x1 == 2*x2, pile2 + x2 == 2*x3, pile3 + x3 == 2*x1, x1 >= 0, x2 >= 0, x3 >= 0, x1 <= pile1, x2 <= pile2, x3 <= pile3}, {x1, x2, x3}, Integers, moves]; If[solutions == {}, {}, {pile1 - x1, pile2 - x2, pile3 - x3} /. solutions[[1]]]]; findSolution[pile1, pile2, pile3, moves]

This give {} or no solution.

However, there does exist a solution. The solution is:

  1. Move 7 matches from the pile with 11 matches to the pile with 7 matches. The piles now contain 4, 14, and 6 matches.

  2. Move 6 matches from the pile with 14 matches to the pile with 6 matches. The piles now contain 4, 8, and 12 matches.

  3. Move 4 matches from the pile with 12 matches to the pile with 4 matches. The piles now contain 8, 8, and 8 matches.

Is there a way to formulate the question so that this is computable with Wolfram Language?

Upvotes: 0

Views: 91

Answers (2)

Bill
Bill

Reputation: 3977

Another solution to add to the ones already posted in Mathematica Stackexchange

move[from_,to_,history_,turns_]:=Module[{board=Last[history],count},
  If[turns<3&&board[[from]]>=board[[to]], (*legal move*)
    count=board[[to]];board[[from]]-=count;board[[to]]+=count;
    If[board=={8,8,8},Print[Join[history,{board}]], (*done*)
      move[1,2,Join[history,{board}],turns+1];
      move[1,3,Join[history,{board}],turns+1];
      move[2,1,Join[history,{board}],turns+1];(*else try all next moves*)
      move[2,3,Join[history,{board}],turns+1];
      move[3,1,Join[history,{board}],turns+1];
      move[3,2,Join[history,{board}],turns+1];
]]];
move[1,2,{{11,7,6}},0];
move[1,3,{{11,7,6}},0];
move[2,1,{{11,7,6}},0]; (*try all first moves*)
move[2,3,{{11,7,6}},0];
move[3,1,{{11,7,6}},0];
move[3,2,{{11,7,6}},0];

which returns

{{11,7,6},{4,14,6},{4,8,12},{8,8,8}}

I've tried several different ways to merge those two groups of six move[] into one group, but I haven't yet found a really nice clean way to do that which satisfies me.

Upvotes: 0

Chris Degnen
Chris Degnen

Reputation: 8655

Brute force approach

moves = Permutations[Catenate[
    ConstantArray[Permutations[{1, 2, 3}, {2}], 3]], {3}];

doset[set_] := Module[{},
  p[1] = 11;
  p[2] = 7;
  p[3] = 6;

  domove[{from_, to_}] := Catch[
    howmany = p[to];
    left = p[from] - howmany;
    If[left < 0, Throw["no good"]];
    p[from] -= howmany;
    p[to] += howmany;
    If[p[1] == p[2] == p[3] == 8, Throw[Print[set]]]];

  domove /@ set]

doset /@ moves;

{{1,2},{2,3},{3,1}}

  1. Move 7 from pile 1 to pile 2

  2. Move 6 from pile 2 to pile 3

  3. Move 4 from pile 3 to pile 1

Upvotes: 1

Related Questions