; 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

; 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)

; 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)

; :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

; Append the new child nodes onto :queue 
to breadthFirstHelperHelper :childNodeList
  if empty? :childNodeList [stop]
  make "queue lput (first :childNodeList) :queue
  breadthFirstHelperHelper (butfirst :childNodeList)

; 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

; Output a sentence of all the pitcher states (volumes) for
; the input :pouring
to getPitcherStates :pouring
  output butfirst :pouring

; 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

; 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

; Output the destination number from a source-destination pair
to sdpDestination :srcDestPair
  output last :srcDestPair

; Identification of the river in a source-destination pair
to riverNum
  output 0

; 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

; 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

; 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)

; 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

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

; 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)

; 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

; Output a word, a number, that is the desired amount of water
to getDesiredAmt
  print [Enter desired amount in a pitcher:\ ]
  output readword

; Debuging aid (xyzzy)
to incrCounter :prefix :resolution
  make "counter (+ :counter 1)
  if equal? 0 (remainder :counter :resolution) ~
     [println sentence "|counter = | :counter]

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