25
$\begingroup$

There is a 8-liter bottle is full of wine. There are two empty bottles that have capacity 5-liters and 3-liters. How can these three bottles be used to separate the wine into two 4-liter portions?

This is my current method:

a = Range[0, 8];
b = Range[0, 5];
c = Range[0, 3];
list = Select[Tuples[{a, b, c}], Total[#] == 8 &];

SetAttributes[CirclePlus, HoldFirst]
CirclePlus[l_[[a_]], b_] := 
 Module[{temp = l}, temp[[a]] = temp[[a]] + b; temp]

g = RelationGraph[
  Or @@ Table[(#1[[1]]⊕-a)[[2]]⊕a === #2, {a, 5}] || 
    Or @@ Table[(#1[[1]]⊕-a)[[3]]⊕a === #2, {a, 3}] || 
    Or @@ Table[(#1[[2]]⊕-a)[[3]]⊕a === #2, {a, 3}] || 
    Or @@ Table[(#1[[2]]⊕-a)[[1]]⊕a === #2, {a, 5}] || 
    Or @@ Table[(#1[[3]]⊕-a)[[1]]⊕a === #2, {a, 3}] || 
    Or @@ Table[(#1[[3]]⊕-a)[[2]]⊕a === #2, {a, 3}] &, list]

But I get a wrong answer.

FindShortestPath[g, {8, 0, 0}, {4, 4, 0}]

{{8, 0, 0}, {4, 4, 0}}

Actually the answer is

{8,0,0}->{3,5,0}->{3,2,3}->{6,2,0}->{6,0,2}->{1,5,2}->{1,4,3}->{4,4,0}

How can I use Mathematica to solve this problem?

$\endgroup$
41
$\begingroup$

How about:

list = Select[Tuples@Range[0, {8, 5, 3}], Total[#] == 8 &];

f[x_, y_] := Count[y ({8, 5, 3} - y) (x - y), 0] >= 2

sp = FindShortestPath[RelationGraph[f, list], {8, 0, 0}, {4, 4, 0}]
(* {{8, 0, 0}, {3, 5, 0}, {3, 2, 3}, {6, 2, 0}, {6, 0, 2}, {1, 5, 2}, {1, 4, 3}, {4, 4, 0}} *)

Explanation for f

  • The transfer is from one bottle to one other, therefore the uninvolved bottle does not change - so $(y - x)$ must contain a zero for that bottle.

  • The transfer must either empty the source bottle (in which case there is a zero in $y$) or fill the destination bottle (in which case there is a zero in $(\{8, 5, 3\} - y)$

  • So overall the product $y(\{8, 5, 3\} - y) (y-x)$ must contain at least two zeros for a valid step.

Gratuitous animation

enter image description here

To make the animation I used the animation sequencing code from here and:

rules = MapThread[Thread[{a, b, c} -> Transpose@{#1, #2}] &,
    {Most@sp, Rest@sp}] ~Riffle~ 0.5 ~Append~ 1;

grfx = {EdgeForm[Blue], FaceForm[],
   Rectangle[{0, 0}, {1, 8}], Rectangle[{2, 0}, {3, 5}], Rectangle[{4, 0}, {5, 3}],
   FaceForm[Red],
   Rectangle[{0, 0}, {1, a}], Rectangle[{2, 0}, {3, b}], Rectangle[{4, 0}, {5, c}]};

{fn, tmax} = anim[grfx, rules];
Animate[Graphics[fn[t]], {t, 0, tmax}]

Those without RelationGraph may use:

g = Graph[ Rule @@@ Pick[#, f @@@ #] & @ Permutations[list, {2}] ];

FindShortestPath[g, {8, 0, 0}, {4, 4, 0}]
$\endgroup$
  • $\begingroup$ I cannot understand your f $\endgroup$ – yode Mar 28 '16 at 10:17
  • 1
    $\begingroup$ @yode, I added some explanation $\endgroup$ – Simon Woods Mar 28 '16 at 10:21
  • 8
    $\begingroup$ @SimonWoods Nice one (+1). Personally, I would have done JohnMcClane[{8, 5, 3}, {4, 4, 0}]. $\endgroup$ – user31159 Mar 28 '16 at 10:32
  • 2
    $\begingroup$ @Xavier I think it would be ZeusCarver[...] or both :) $\endgroup$ – ubpdqn Mar 28 '16 at 11:14
  • 1
    $\begingroup$ @iFikr I added the animation code. $\endgroup$ – Simon Woods Apr 3 '16 at 19:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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