Jug problems are a popular puzzle: given a set of jugs with distinct* integral capacities that are otherwise unmarked, measure out a specified integral volume of liquid.
For example, you may have jugs with capacities of 5, 8 and 12 litres (Americans may substitute gallons, and Texans may substitute hats for jugs) and be asked to measure out 6 litres of water.
The available steps are to fill any jug from a tap, empty any jug, or pour as much liquid as possible from one jug into another without overfilling it.
In this example, there is a shortcut: 3 is a divisor of 6, and 3 = 8 – 5. So one solution is
- Fill the 8 litre jug
- Pour 5 litres from the 8 litre jug into the 5 litre jug
- Pour the remaining 3 litres from the 8 litre jug into the 12 litre jug
- Empty the 5 litre jug (or pour it into the 8 litre jug)
- Repeat steps 1-3, leaving 6 litres in the 12 litre jug.
In general, it is inefficient to look for shortcuts, and we will use brute force.
- Published puzzles do always have distinct capacities, and this assumption means the jugs can be identified by their capacity.
Jug puzzles do not necessarily have solutions – for example, when the jug sizes are all even and the target is odd.
There are various ways of filtering out insoluble puzzles, but they approach looking for a solution in complexity.
There is a limited number of possible states: in the example it is (5 + 1) * (8 + 1) * (12 + 1), so if there is a solution, it can be found in fewer than 702 steps. Conversely, any longer solutions must include loops or void steps (such as emptying an empty jug) which can be omitted.
This program builds a tree of steps, with limited depth, converts it to a tree with a breadcrumb trail from the leaves to the root, does a breadth-first search for a node that solves the problem, and prints out the sequence of operations. Haskell’s lazy evaluation means that the tree is only constructed to the depth of the first solution.
{-# LANGUAGE TupleSections #-}
import qualified Data.Tree as T
import System.Environment (getArgs)
import qualified Data.IntMap.Strict as M
type Jug = Int -- value will be name (= capacity) of jug
type Contents = M.IntMap Int -- map from capacities of jugs to contents
emptyJugs::[Jug]->Contents
emptyJugs jugs = M.fromList $ map (,0) jugs
data Action = Start | Empty Jug | Fill Jug | Pour Jug Jug
actions::Contents->[Action]
actions jugs =
let notEmptyJugs = M.keys $ M.filter (/=0) jugs
notFullJugs = M.keys $ M.filterWithKey (/=) jugs in -- works because key == capacity
[Empty a | a<-notEmptyJugs] ++
[Fill a | a<-notFullJugs] ++
[Pour a b | a<-notEmptyJugs, b<-notFullJugs, a/=b]
-- M.adjust takes a function to be applied to an existing value. This function sets it to a fixed value.
set::Int->Int->Contents->Contents
set key value m = M.adjust (const value) key m
apply::Action->Contents->Contents
apply Start contents = contents
apply (Empty jug) contents = set jug 0 contents
apply (Fill jug) contents = set jug jug contents -- works because key == capacity
apply (Pour source dest) contents =
let gap = dest - ((M.!) contents dest) -- free space in target jug
amount = (M.!) contents source -- amount in source jug
in if gap >= amount
then set source 0 $ M.adjust (+ amount) dest contents
else set dest dest $ M.adjust (+ (-gap)) source contents -- (- gap) is unary; ((-) gap) would be the wrong way round; ((flip (-)) gap) would work.
type NodeLabel = (Action, Contents) -- action and contents after applying the action
-- generate a node (including its child nodes) from a label. This function is used in T.unfoldTree
buildNode::NodeLabel->(NodeLabel,[NodeLabel])
buildNode (action,contents) = ((action,contents),[(a,(apply a contents)) | a<-(actions contents)])
limitDepth::Int->(T.Tree NodeLabel)->T.Tree NodeLabel
limitDepth 0 (T.Node rootLabel _) = T.Node rootLabel []
limitDepth n (T.Node rootLabel subForest) =
T.Node rootLabel (map (limitDepth (n-1)) subForest)
-- transform an ordinary Tree into a Tree with a breadcrumb trail from leaves to root
breadcrumb :: [a] -> T.Tree a -> T.Tree [a]
breadcrumb ancestors (T.Node label subForest) =
let newLabel = label:ancestors in
T.Node newLabel $ map (breadcrumb newLabel) subForest
maxDepth::[Jug]->Int
maxDepth jugs = product $ map (+1) jugs
start::[Jug]->NodeLabel
start jugs = (Start,(emptyJugs jugs))
isSolution::Int->[NodeLabel]->Bool
isSolution target steps =
not $ M.null $
M.filter (==target) $
snd $ -- second item is the contents
head $ -- first step in list is the final state
steps
solutions::[Jug]->Int->[[NodeLabel]]
solutions jugs target =
filter (isSolution target) $
concat $
T.levels $ -- breadth-first search
breadcrumb [] $
limitDepth (maxDepth jugs) $
T.unfoldTree buildNode $
start jugs
firstSolution::[[NodeLabel]]->[NodeLabel]
firstSolution [] = []
firstSolution (x:_) = reverse x
solve::[Jug]->Int->[NodeLabel]
solve jugs target = firstSolution $ solutions jugs target
pad::Int->String->String
pad n s = take n $ s ++ (cycle " ")
pad' = pad 30
instance Show Action where
show Start = pad' "Start"
show (Empty jug) = pad' $ concat ["Empty jug ",show jug]
show (Fill jug) = pad' $ concat ["Fill jug ",show jug]
show (Pour source dest) = pad' $ concat ["Pour from jug ",show source, " to jug ",show dest]
main::IO ()
main = do
args<-getArgs
let jugs = read (args!!0)
let target = read (args!!1)
mapM_ print $ map (\(x,y)->(x,(M.toList y))) $ solve jugs target
Review
If the puzzle has a solution, a solution with minimal length is found quickly
:main "[5,8,12]" "6"
(Start ,[(5,0),(8,0),(12,0)])
(Fill jug 5 ,[(5,5),(8,0),(12,0)])
(Fill jug 8 ,[(5,5),(8,8),(12,0)])
(Pour from jug 5 to jug 12 ,[(5,0),(8,8),(12,5)])
(Fill jug 5 ,[(5,5),(8,8),(12,5)])
(Pour from jug 5 to jug 12 ,[(5,0),(8,8),(12,10)])
(Pour from jug 8 to jug 12 ,[(5,0),(8,6),(12,12)])
(0.03 secs, 11,782,184 bytes)
This is shorter than the solution proposed in the introduction.
If there is no solution, it takes an inordinate time (nearly 2 minutes) before returning with no output.
:main "[2,4]" "3" (108.91 secs, 22,016,530,744 bytes)
I considered two other approaches:
- Build the breadcrumb trail as part of buildNode instead of transforming the tree. This would be a bit tricky because the type of buildNode is constrained by Data.Tree.unfoldTree. Because of lazy evaluation, it is not necessarily more efficient. Also, I thought that breadcrumb would be a reusable function that would make me famous.
- Make the breadcrumb trail by links to the parent node instead of having a complete history in each node. I started doing this first but got stuck. Having seen a working program, I think the key is to make the type NodeLabel recursive: type NodeLabel = (Action,Contents,NodeLabel).
The puzzle involves interpreting the list of steps in two ways: evaluating the effect on the jugs and printing the list. This suggests that the steps should be free monads. I will try this.
The approach also involves generating a tree from the root and synthesising an answer from the leaves. This suggests that an attribute grammar should be used. Unfortunately, HappyAG https://www.haskell.org/happy/doc/html/sec-AtrributeGrammarsInHappy.html only works with trees where the nodes have a fixed number of named branches, and the documentation for the Utrecht University attribute grammar http://foswiki.cs.uu.nl/foswiki/HUT/AttributeGrammarSystem has been unavailable for over two years.
The invariants of the problem – that the jugs are never overfilled or less than empty – are preserved implicitly by the apply function, but it would be nice to make them explicit with a finite number type.
Further work: investigate how effectively lazy evaluation is being used.
Great Wall 