# How to divide the wine into two equal portions?

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[]⊕-a)[]⊕a === #2, {a, 5}] ||
Or @@ Table[(#1[]⊕-a)[]⊕a === #2, {a, 3}] ||
Or @@ Table[(#1[]⊕-a)[]⊕a === #2, {a, 3}] ||
Or @@ Table[(#1[]⊕-a)[]⊕a === #2, {a, 5}] ||
Or @@ Table[(#1[]⊕-a)[]⊕a === #2, {a, 3}] ||
Or @@ Table[(#1[]⊕-a)[]⊕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}}

{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?

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 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}]

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