;;; -*- 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 . ;;; ;;; 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