;;;; Implementacao de Busca para o Problema do Vasilhame
;;;; Modificado por Hemerson Pistori - http://www.ec.ucdb.br/~pistori
;;;; Utilizei o codigo cuja licenca segue abaixo:
;;;;
;;;; Para executar (em linux) faça:
;;;; --> # Abra um interpretador Lisp, através de um shell (xterm)
;;;; --> list ou clisp
;;;; --> # Carregue o programa 
;;;; --> (load "vasilhame")
;;;; --> # Mostre solução usando busca em profundidade
;;;; --> (depth-first EstadoInicial EstadoFinal)
;;;;
;;;; -*- mode:Lisp; package:user -*- ;;;;
;;;; Created: 10 December 1992
;;;; Copyright 1992 Patrick H. Winston and Berthold K. P. Horn.
;;;; All rights reserved.
;;;;
;;;; Version 1.0.1, copied from master file on 23 Apr 93       
;;;; 
;;;; This software is licensed by Patrick H. Winston and Berthold K. P. Horn
;;;; (licensors) for instructional use with the textbooks ``Lisp,'' by Patrick
;;;; H. Winston and Berthold K. P. Horn, and ``Artificial Intelligence,'' by
;;;; Patrick H. Winston.  Your are free to make copies of this software and
;;;; modify it for such instructional use as long as:
;;;; 1. You keep this notice intact.
;;;; 2. You cause any modified files to carry a prominent notice stating
;;;;    that you modified the files and the date of your modifications.
;;;; This software is licensed ``AS IS'' without warranty and the licensor
;;;; shall have no liability for any alleged defect or damages.

;;;; PROCEDURES

(setf EstadoInicial `(0 0))
(setf EstadoFinal `(0 2))

; A funcao member nao funciona quando os elementos sao listas,
; por isto criei a funcao abaixo. (Provavelmente existe alguma
; coisa pronta em clisp, no entanto, achei mais facil implementar
; do que procurar.
(defun lmember (e l)
   (cond ( (null l) nil )
         ( (equal (first l) e) T )
         ( T (lmember e (rest l) ))
   )
)


; Recebe uma seqüência de estados (invertida) e gera as possíveis novas
; seqüências, aplicando os operadores no primeiro estado da
; seqüência. Exemplo de utilização:
; 
; (setf resultado (extend '((0 0))))
; (extend (first resultado))
(defun extend (path)
  (print (reverse path))                             ;Print path.
  (mapcar #'(lambda (new-node) (cons new-node path)) ;Form new paths.
          (remove-if #'(lambda (neighbor) (lmember neighbor path))
                     (AplicaOperadores (first path)))))

(defun AplicaOperadores (Estado)
  (let ((Novos nil) (x (first Estado)) (y (second Estado)))
     (cond ( (and (= x 0) (= y 0))
                (setf Novos (cons `(3 0) Novos))
                (setf Novos (cons `(0 4) Novos))
           )
           ( (and (> x 0) (= y 0))
                (setf Novos (cons `(0 0) Novos))
                (setf Novos (cons (list 0 x) Novos))
                (setf Novos (cons (list x 4) Novos))
           )
           ( (and (= x 0) (> y 0))
                (setf Novos (cons `(0 0) Novos))
                (setf Novos (cons (list (min y 3)  (max 0 (- y 3))) Novos))
                (setf Novos (cons (list 3 y) Novos))
           )
           ( (and (> x 0) (> y 0))
                (setf Novos (cons (list 0 y) Novos))
                (setf Novos (cons (list x 0) Novos))
                (setf Novos (cons (list (min (+ y x) 3)  (max 0 (- y (- 3 x)))) Novos))
           )
     )
  )
)

(defun depth-first (start finish &optional
                                 (queue (list (list start))))
  (cond ((endp queue) nil)                      ;Queue empty?
        ((equal finish (first (first queue)))      ;Finish found?
         (reverse (first queue)))               ;Return path.
        (t (depth-first                         ;Try again.
             start
             finish
             (append (extend (first queue))     ;New paths in front.
                     (rest queue))))))          ;Skip extended path.

(defun breadth-first (start finish &optional
                                   (queue (list (list start))))
  (cond ((endp queue) nil)                      ;Queue empty?
        ((equal finish (first (first queue)))      ;Finish found?
         (reverse (first queue)))               ;Return path.
        (t (breadth-first                       ;Try again.
             start
             finish
             (append (rest queue)                ;Skip extended path.
                     (extend (first queue))))))) ;New paths in back.

(defun best-first (start finish &optional
                                (queue (list (list start))))
  (cond ((endp queue) nil)                      ;Queue empty?
        ((equal finish (first (first queue)))      ;Finish found?
         (reverse (first queue)))               ;Return path.
        (t (best-first                          ;Try again.
             start
             finish
             (sort (append (extend (first queue))
                           (rest queue))
                   #'(lambda (p1 p2) (closerp p1 p2 finish)))))))