4
$\begingroup$

I recently came across this problem on reddit. The problem is supposed to be read like a snake, and the result of each succesive operation is sent to the next operation: enter image description here

There are 9 blank boxes and each one is a unique integer from 1 to 9. The job is to find the values you can put into the boxes to make it end up equaling 66. The colons (:) represent division.

So for example, if you call each succesive blank box c[i], the result of the first operation is c[1] + 13. This is then sent to the next operation giving (c[1] + 13) * c[2] , then ((c[1] + 13) * c[2])/c[3] and so on.

I was hoping to find a nice way to use Fold or Nest here, but I am confused on how to use something like Fold here when the operation changes at each step.

For now, I am just writing the operations in one list, and the numbers/unknowns in another list (you can also see this in my comment on the reddit post):

operations = {Plus, Times, Divide, Plus, Plus, Times, Subtract, 
   Subtract, Plus, Times, Divide, Subtract, Equal};

nums = {c[1], 13, c[2], c[3], c[4], 12, c[5], c[6], 11, c[7], c[8], 
   c[9], 10, 66};

I then succesively apply the operations in a Do loop:

(*initialize equation as the first number (c[1])*)
equation = nums[[1]];
numOps = operations // Length;
Do[

(*apply the next operation to equation and the next number*)
 equation = operations[[i]][equation, nums[[i + 1]]];

 , {i, numOps}
 ]
equation

(*

-10 + ((-11 + (12 + ((13 + c[1]) c[2])/c[3] + c[4]) c[5] - c[6] + 
     c[7]) c[8])/c[9] == 66

*)

I then find which permutations of Range @ 9 satisfy equation. There are 152 solutions:

cArr = Array[c, 9];
perms = Permutations[Range@9];
rules = Thread[cArr -> #] & /@ perms;
tests = equation /. rules;
Tally[tests]

(*{{False, 362728}, {True, 152}}*)

My question is how can I do this in a more Mathematica-like way? Is there a way to use Fold or Nest here when the operation changes at each step?

My understanding of Fold[f , x , list] is that the operation f has to be constant at each step, but I need to use a different operation (from the list operations at each step) and I am struggling to figure out a way to do this without a looping construct like Do

$\endgroup$

2 Answers 2

4
$\begingroup$

Here is a way to use Fold, that uses the iterator trick I learned here years ago:

Module[{i = 1}, Fold[operations[[i++]][##] &, nums]]

or

Fold[Module[{i = 1}, operations[[i++]][##] &], nums]
$\endgroup$
4
$\begingroup$

Maybe

equation = Fold[#2[[1]][#1, #2[[2]]] &, First@nums, Transpose[{operations, Rest@nums}]]

The Transpose[{operations, Rest@nums}] basically creates pairs of your nums and operations, and it looks like this:

{{Plus, 13}, {Times, c[2]}, {Divide, c[3]}, {Plus, c[4]}, {Plus, 12},
 {Times, c[5]}, {Subtract, c[6]}, {Subtract, 11}, {Plus, c[7]}, 
 {Times, c[8]}, {Divide, c[9]}, {Subtract, 10}, {Equal, 66}}

We start off the process with nums[[1]], so we don't include that one in our pairs. At each step in the Fold, we'll be passed two arguments. The first will be the total so far and the second will be the next operation-number pair. So, this function, #2[[1]][#1, #2[[2]]] &, extracts the operation and applies it to the pair consisting of the total so far and the new number extracted from the second argument.

Another alternate:

equation = Fold[Construct[#2, #1] &, First@nums, MapThread[OperatorApplied[#1][#2] &, {operations, Rest@nums}]]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.