; PitcherProblemSolver - CSLS v1, Chapter 14, Solving Pitcher Problems
; --------------------
; Global Data
; ------ ----
; initially empty, set to a solution node when one is found
global "solution
; the amount of water desired in a pitcher
global "desiredAmount
; sentence containing the sizes of the provided pitchers
global "pitcherSizes
; Common General Procedures
; ------ ------- ----------
; Output the number of pitchers in the current challenge
to numPitchers
output count :pitcherSizes
end
; Output a copy of the input :list with the :index-th
; member replaced with the input :value
to replaceMember :list :index :value
if equal? :index 1 [output fput :value butfirst :list]
output fput first :list (replaceMember butfirst :list :index-1 :value)
end
; Tree Walking Stuff
; ---- ------- -----
; Two algorithms are provided which iterate through all nodes of a
; tree: depthFirst and breadthFirst.
;
; Each of these procedures expects two procedures to exist
;
; (1) processNode - invoked for every node of the tree
; one input, a node
;
; (2) childNodes - invoked to get a list of child nodes for a node
; one input, a node
; ...
; perform a breadthFirst traversal of a tree
; the procedure processNode is invoked for each node in the tree
; the function childNodes, which has one input :node, should output
; a list of the :node's children
; :node should contain the root node of the tree
to breadthFirst :node
breadthFirstHelper (list :node)
end
; :queue is a list of nodes to be processed
; for every member of the queue, from first to last, the first
; node from :queue is passed to two procedures (processNode
; and childNodes) as an input.
; processNode checks to see if its input :node, a pouring data
; structure, has a pitcher with the desired amount. If so,
; global variable solution is set to the node.
; childNodes outputs a list of nodes that are children of the
; input node. These nodes are appended to :queue to be
; processed later.
to breadthFirstHelper :queue
if empty? :queue [stop]
processNode first :queue
if not empty? :solution [stop]
breadthFirstHelperHelper (childNodes first :queue)
breadthFirstHelper butfirst :queue
end
; Append the new child nodes onto :queue
to breadthFirstHelperHelper :childNodeList
if empty? :childNodeList [stop]
make "queue lput (first :childNodeList) :queue
breadthFirstHelperHelper (butfirst :childNodeList)
end
; Data Structures
; ---- ----------
;
; A pouring is a list
;
; - Its first member is a sentence with two numbers, the
; source-destination-pair (srcDestPair) of the pouring
;
; - Its butfirst members are the resultant pitcher state values,
; the amount of water in each pitcher, a number for each pitcher
; Output the source-destination-pair (srcDestPair) sentence
; for the input :pouring
to getSrcDestPair :pouring
output first :pouring
end
; Output a sentence of all the pitcher states (volumes) for
; the input :pouring
to getPitcherStates :pouring
output butfirst :pouring
end
; Output a root node for a tree which will be built containing
; permutations (nodes) that could lead to or be a solution to
; the current pitcher pouring challenge. It consists of a list
; with an empty source-destination pair and zeros for the
; contents of pitchers.
to rootNode
localmake "pitchersState []
repeat numPitchers [make "pitchersState fput 0 :pitchersState]
output fput [] :pitchersState
end
; A source-destination-pair (sentence) consists of two numbers,
; source number first, destination number last
;
; The value zero (0) is used to represent the river (riverNum)
; Values greater than zero are pitcher numbers, i.e., indexes
; into the (global variable) pitcherSizes and the pitcherStates
; part of a pouring
; Output the source number from a source-destination pair
to sdpSource :srcDestPair
output first :srcDestPair
end
; Output the destination number from a source-destination pair
to sdpDestination :srcDestPair
output last :srcDestPair
end
; Identification of the river in a source-destination pair
to riverNum
output 0
end
; Support for the tree traversal framework. Given a :node as input,
; output a list of the children of that node.
;
; This implementation of childNodes supports a search for a pitcher
; with :desiredAmount (global variable) of water. The list of child
; nodes output consists of all permutations of source and destination
; pairings (srcDestPairs) and the resultant pitcher states for them.
; Only pourings that make sense to check as a possible solution are
; included, e.g., a pouring where source = destination does not
; make sense...
;
; Note: childNodesHelper and childNodesHelperHelper take advantage
; of Logo's dynamic scope, e.g., :node is an input to childNodes and
; is referenced in childNodesHelperHelper, childNodeList is declared
; in childNodes and modified in childNodesHelperHelper.
; output a list of child nodes for the given :node
to childNodes :node
localmake "childNodeList []
childNodesHelper riverNum numPitchers
output :childNodeList
end
; iterate through all possible source numbers
; invoke childNodesHelperHelper for each
to childNodesHelper :src :maxSrcDest
if greater? :src :maxSrcDest [stop]
childNodesHelperHelper riverNum
childNodesHelper (+ :src 1) :maxSrcDest
end
; iterate through all possible destination numbers. for each, compute
; the new pitcher states for the source-destination pair and combine
; them to form a new pouring. Append the new pouring onto childNodeList
to childNodesHelperHelper :dest
if greater? :dest :maxSrcDest [stop]
localmake "curStates getPitcherStates :node
localmake "newSrcDestPair sentence :src :dest
localmake "newState newPitcherStates :curStates :newSrcDestPair
localmake "pouring fput :newSrcDestPair :newState
make "childNodeList lput :pouring :childNodeList
childNodesHelperHelper (+ :dest 1)
end
; Output a new sentence of pitcher-states (volumes) given an existing
; pitcher-states sentence and a source-destination pair for a new pouring
to newPitcherStates :existingStates :srcDestPair
localmake "dest sdpDestination :srcDestPair
localmake "src sdpSource :srcDestPair
if equal? :src :dest [output :existingStates]
; if destination is river, source is now empty
if equal? :dest riverNum [output replaceMember :existingStates :src 0]
; if source is river, destination (which must be a pitcher) is now full
localmake "destPitcherCapacity (item :dest :pitcherSizes)
if equal? :src riverNum ~
[output replaceMember :existingStates :dest :destPitcherCapacity]
; pouring is pitcher to pitcher so the state of both will change
localmake "srcPitcherVolume (item :src :existingStates)
localmake "destPitcherVolume (item :dest :existingStates)
localmake "destPitcherAvailSpace (- :destPitcherCapacity :destPitcherVolume)
; if destination pitcher has room for the contents of the source pitcher,
; empty source into destination
if lessequal? :srcPitcherVolume :destPitcherAvailSpace ~
[localmake "newStates replaceMember :existingStates ~
:dest ~
(+ :destPitcherVolume :srcPitcherVolume) ~
output replaceMember :newStates :src 0]
; destination pitcher has room for some of the source pitcher's water, but not all
localmake "newStates replaceMember :existingStates ~
:src ~
(- :srcPitcherVolume :destPitcherAvailSpace)
output replaceMember :newStates :dest :destPitcherCapacity
end
; Check :node to see if one of the pitchers has the desired amount
; If found, set the global variable "solution to the node
to processNode :node
;print "|processNode | show :node
incrCounter "|processNode: | 10 ;xyzzy
if member? :desiredAmount (getPitcherStates :node) [make "solution :node]
end
; Print the solution as a list of pouring steps, e.g.,
;
; Pour from the river to pitcher #2 (0/3 7/7)
; Pour from pitcher #2 to pitcher #1 (3/3 4/7)
;
; and the pitcher with the solution
;
; Pitcher #2 contains 4 units
;
to printSolution
show :solution
; xyzzy
println sentence "|Node count: | :counter
println sentence "|Time (seconds): | (/ (- time :startTime) 1000)
end
; Initialization
;---------------
; Get problem information from the user, the available pitcher sizes and
; the target amount of water desired in one
; Output a sentence containing sizes of available pitchers
to getPitcherSizes
print [Enter sizes of pitchers (e.g. 2 5):\ ]
output readlist
end
; Output a word, a number, that is the desired amount of water
to getDesiredAmt
print [Enter desired amount in a pitcher:\ ]
output readword
end
; Debuging aid (xyzzy)
to incrCounter :prefix :resolution
make "counter (+ :counter 1)
if equal? 0 (remainder :counter :resolution) ~
[println sentence "|counter = | :counter]
end
; MAIN
; ----
to main
make "counter 0 ;xyzzy
make "startTime time ;xyzzy
make "solution "null
make "pitcherSizes getPitcherSizes
make "desiredAmount getDesiredAmt
breadthFirst rootNode
ifelse empty? :solution [println [There is no solution!]] [printSolution]
end