;;; -*- Mode: Lisp -*-
;;;
;;; Answers to exercises in chapter 1 of Nilsson's Principles of A.I.
;;; Copyright (C) 2021 Gene Michael Stover (gene@acm.org)
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <https:;;www.gnu.org/licenses/>.
;;;
;;; Documentation is at http://cybertiggyr.com/nilsson_principles/00readme.html
;;;

(defpackage "NILSON_PRINCIPLES.EX_01_02"
  (:use "COMMON-LISP"))

(in-package "NILSON_PRINCIPLES.EX_01_02")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; We'll do breadth-first search in the hopes of finding a shortest
;;; number of steps to the solution.  I guess best-first would
;;; accomplish the same thing, but that would require slightly more
;;; code, & I'm trying to do this quick-&-dirty.
;;;

;;;
;;; And element in the queue is the world & a list of the operations
;;; that led up to it.  We'll do that as a 2-element list.  The
;;; FIRST is the WORLD.  The SECOND is a list of operations.
;;;
;;; An operation gives us a (possibly empty) list of new worlds.
;;; We'll remove all the losing worlds from that list.  What
;;; remains is appended to the queue.
;;;

(defstruct world details comment history)

;;;
;;; Given a world, apply all the operations to generate a list of
;;; new worlds.  And remove failing worlds from that list.  What
;;; you get fromthis function is a (possibly empty) list of new,
;;; non-failing worlds.
;;;
(defun next-worlds (x ops is-lose?)
  (remove-if is-lose? (mapcar (lambda (op) (funcall op x)) ops)))

(defun breadth (start ops is-win? is-lose?)
  (do ((q (list (make-world :details start :comment "Start." :history nil))
	  (append (rest q)
		  (next-worlds (first q) ops is-lose?)))
       (count 0 (+ 1 count))
       (max-depth 0 (max max-depth (length q))))
      ((or (endp q) (is-win? (first q)))
       (values (and q (first q))
	       count
	       max-depth))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; WATER JUGS
;;;
;;; We have a 5-litre water jug containing 5 litres of water.
;;; We have a 2-litre water jug that is empty.
;;;
;;; If you can get exactly 1 liter of water into the 2-litre jug,
;;; you win.
;;;

;;;
;;; The state of the world is: amount of water in the 5-litre jug,
;;; amount of water in the 2-litre jug
;;;
;;; We'll call them BIG jug and LITTLE jug.
;;;

;;;
;;; The state of the destination bank is...
;;; an association list.  The keys are :BIG and :LITTLE.
;;; We use an association list to make it easy to refer
;;; to the jugs from the operations.
;;;
(defun jug (w capacity) (second (assoc capacity (world-details w))))
(defun set-jug (w jug litres)
  (make-world
   :details (cons (list jug litres)
		  (remove jug (world-details w) :key 'first))
   :history (world-history w)))

;;;
;;; You win the game if there is 1 litre in the little jug.
;;;
(defun is-win? (w) (eql 1 (jug w 2)))

;;;
;;; The game is unwinnable if the total amount of water remaining
;;; is less than 1 litre.  Remember that the total amount is the
;;; sum of the amounts in both jugs.
;;;
;;; Also unwinnable if the current state is a repeat of a state
;;; that's back in history.
;;;
(defun is-lose? (w)
  (or (null w)
      (< (+ (jug w 2) (jug w 5)) 1)
      (find (world-details w) (world-history w) :key 'world-details
       	    :test 'equal)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; TRANSFORMATIONS
;;;
;;; Unlike excersie 1.1 (in "ex_01_01.lisp"), I'll avoid hard-coding
;;; all
;;;

(defun make-pour-out (capacity)
  (lambda (w &aux message)
    (if (<= (jug w capacity) 0)
	;; The jug is empty, so do nothing.
	nil
      ;; else
      (progn
	(setq message (format nil "Pour ~D from ~A onto the ground."
			      (jug w capacity) capacity))
	(make-world
	 :details (cons (list capacity 0)
			(remove capacity (world-details w) :key 'first))
	 :comment message
	 :history (cons w (world-history w)))))))

(defun make-empty-into (source dest)
  (lambda (w &aux newdest message)
    (if (<= (jug w source) 0)
	;; The just is empty, so do nothing.
	nil
      ;; else
      (progn
	(setq newdest (min dest (+ (jug w dest) (jug w source))))
	(setq message (format nil "Pour ~D from ~A into ~A."
			      (jug w source) source dest))
	(make-world
	 :details (list (list source 0)
			;; We combine the water from source & dest, but what
			;; remains in dest is not more than its capacity.
			(list dest newdest))
	 :comment message
	 :history (cons w (world-history w)))))))

(defun make-fill-into (source dest)
  (lambda (w &aux delta message newsource newdest)
    (if (<= (jug w source) 0)
	;; The jug is empty.
	nil
      ;; else
      (progn
	;; The amount to pour (DELTA) is minimum of what the
	;; destination can contain & what the source contains.
	(setq delta (min (jug w source) (- dest (jug w dest))))
	;; The new amounts
	(setq newsource (- (jug w source) delta)
	      newdest (+ (jug w dest) delta))
	(setq message (format nil "Pour ~D from ~A into ~A." delta source dest))
	(make-world
	 :details (list (list source newsource)
			(list dest newdest))
	 :comment message
	 :history (cons w (world-history w)))))))

(defparameter *ops* nil)
(setq *ops* (list (make-pour-out 2) (make-pour-out 5)
		  (make-empty-into 2 5) (make-empty-into 5 2)
		  (make-fill-into 2 5) (make-fill-into 5 2)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;
;;;

(defun print-world (w)
  (dolist (x (reverse (cons w (world-history w))))
    (format t "~A [~D, ~D]~%" (world-comment x) (jug x 2) (jug x 5)))
  'print-world)

(defun run () (breadth '((2 0) (5 5)) *ops* 'is-win? 'is-lose?))

;;; end of file