;jarras.lsp
; Permite pasar, por ejemplo, de (0 0) a (0 4)
;

(setq bc '(

; Llenar la jarra de 5
           (lambda (x) (if (< (jarra5 x) 5) (list 5 (jarra8 x)) x))

; Vaciar la jarra de 5
           (lambda (x) (if (> (jarra5 x) 0) (list 0 (jarra8 x)) x))

; Volcar en la jarra de 5 todo el contenido de la jarra de 8 (que queda vacia)
           (lambda (x) (if (>= (- 5 (jarra5 x)) (jarra8 x)) (list (+ (jarra5 x) (jarra8 x)) 0) x))

; Llenar la jarra de 5 con parte del contenido de la jarra de 8
           (lambda (x) (if (< (- 5 (jarra5 x)) (jarra8 x)) (list 5 (- (jarra8 x) (- 5 (jarra5 x)))) x))

; Llenar la jarra de 8
           (lambda (x) (if (< (jarra8 x) 8) (list (jarra5 x) 8) x))

; Vaciar la jarra de 8
           (lambda (x) (if (> (jarra8 x) 0) (list (jarra5 x) 0) x))

; Volcar en la jarra de 8 todo el contenido de la jarra de 5 (que queda vacia)
           (lambda (x) (if (>= (- 8 (jarra8 x)) (jarra5 x)) (list 0 (+ (jarra8 x) (jarra5 x))) x))

; Llenar la jarra de 8 con parte del contenido de la jarra de 5
           (lambda (x) (if (< (- 8 (jarra8 x)) (jarra5 x)) (list (- (jarra5 x) (- 8 (jarra8 x))) 8) x))

          )
)

(defun jarra5 (x) (car x))

(defun jarra8 (x) (cadr x))

;breadth.lsp
(defun breadth-first (bc)
    (princ "Ingrese el estado inicial: ") (setq inicial (read))
    (princ "Ingrese el estado   final: ") (setq final (read))
    (cond ((equal inicial final) (princ "El problema ya esta resuelto !!!") (terpri) (breadth-first))
          (t (buscar bc final (list (list inicial)) nil))))

(defun buscar (bc fin grafobusq estexp)
;(terpri)
;(princ " Grafo: ") (princ grafobusq) (terpri)
;(princ "EstExp: ") (princ estexp) (terpri)
    (cond ((null grafobusq) (fracaso))
          ((pertenece fin (first grafobusq)) (exito grafobusq))
          (t (buscar bc fin (append (rest grafobusq) (expandir (first grafobusq) bc estexp))
                            (if (pertenece (first (first grafobusq)) estexp) estexp (cons (first (first grafobusq)) estexp))))))

(defun expandir (linea basecon estexp)
    (if (or (null basecon) (pertenece (first linea) estexp)) nil
      (if (not (equal (funcall (eval (first basecon)) (first linea)) (first linea)))
          (cons (cons (funcall (eval (first basecon)) (first linea)) linea) (expandir linea (rest basecon) estexp))
          (expandir linea (rest basecon) estexp))))

(defun pertenece (x lista)
  (cond ((null lista) nil)
        ((equal x (first lista)) t)
        (t (pertenece x (rest lista)))))

(defun exito (grafobusq)
    (princ "Exito !!!") (terpri)
    (princ "Prof ....... ") (princ (- (length (first grafobusq)) 1)) (terpri)
    (princ "Solucion ... ") (princ (reverse (first grafobusq))) (terpri) t)

(defun fracaso ()
    (princ "No existe solucion") (terpri) t
)

(print (breadth-first bc))

;puzzle8.lsp
; Permite pasar, por ejemplo, de (0 1 2 5 6 3 4 7 8) a (1 2 3 4 5 6 7 8 0)
;
;      0 1 2       1 2 3
; De   5 6 3   a   4 5 6   moviendo siempre el 0
;      4 7 8       7 8 0


(setq bc '(
           (lambda (x) (if (= (item 1 x) 0) (intercambiar 1 2 x) x))
           (lambda (x) (if (= (item 1 x) 0) (intercambiar 1 4 x) x))
           (lambda (x) (if (= (item 2 x) 0) (intercambiar 2 1 x) x))
           (lambda (x) (if (= (item 2 x) 0) (intercambiar 2 3 x) x))
           (lambda (x) (if (= (item 2 x) 0) (intercambiar 2 5 x) x))
           (lambda (x) (if (= (item 3 x) 0) (intercambiar 3 2 x) x))
           (lambda (x) (if (= (item 3 x) 0) (intercambiar 3 6 x) x))
           (lambda (x) (if (= (item 4 x) 0) (intercambiar 4 1 x) x))
           (lambda (x) (if (= (item 4 x) 0) (intercambiar 4 5 x) x))
           (lambda (x) (if (= (item 4 x) 0) (intercambiar 4 7 x) x))
           (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 2 x) x))
           (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 4 x) x))
           (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 6 x) x))
           (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 8 x) x))
           (lambda (x) (if (= (item 6 x) 0) (intercambiar 6 3 x) x))
           (lambda (x) (if (= (item 6 x) 0) (intercambiar 6 5 x) x))
           (lambda (x) (if (= (item 6 x) 0) (intercambiar 6 9 x) x))
           (lambda (x) (if (= (item 7 x) 0) (intercambiar 7 4 x) x))
           (lambda (x) (if (= (item 7 x) 0) (intercambiar 7 8 x) x))
           (lambda (x) (if (= (item 8 x) 0) (intercambiar 8 7 x) x))
           (lambda (x) (if (= (item 8 x) 0) (intercambiar 8 5 x) x))
           (lambda (x) (if (= (item 8 x) 0) (intercambiar 8 9 x) x))
           (lambda (x) (if (= (item 9 x) 0) (intercambiar 9 6 x) x))
           (lambda (x) (if (= (item 9 x) 0) (intercambiar 9 8 x) x))
          )
)

(defun intercalar (x num lista)
    (append (subseq lista 0 (- num 1)) (cons x (nthcdr (- num 1) lista))))

(defun cambiar (x num lista)
    (intercalar x num (borrar num lista)))

(defun intercambiar (n1 n2 lista)
    (cambiar (item n1 lista) n2 (cambiar (item n2 lista) n1 lista)))

(defun item (n lista)
  (if (equal n 1) (first lista) (item (- n 1) (rest lista))))

(defun borrar (num lista)
  (append (subseq lista 0 (- num 1)) (nthcdr num lista)))