SHARE
TWEET

Untitled

a guest May 21st, 2019 76 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ;jarras.lsp
  2. ; Permite pasar, por ejemplo, de (0 0) a (0 4)
  3. ;
  4.  
  5. (setq bc '(
  6.  
  7. ; Llenar la jarra de 5
  8.            (lambda (x) (if (< (jarra5 x) 5) (list 5 (jarra8 x)) x))
  9.  
  10. ; Vaciar la jarra de 5
  11.            (lambda (x) (if (> (jarra5 x) 0) (list 0 (jarra8 x)) x))
  12.            
  13. ; Volcar en la jarra de 5 todo el contenido de la jarra de 8 (que queda vacia)
  14.            (lambda (x) (if (>= (- 5 (jarra5 x)) (jarra8 x)) (list (+ (jarra5 x) (jarra8 x)) 0) x))
  15.            
  16. ; Llenar la jarra de 5 con parte del contenido de la jarra de 8
  17.            (lambda (x) (if (< (- 5 (jarra5 x)) (jarra8 x)) (list 5 (- (jarra8 x) (- 5 (jarra5 x)))) x))
  18.            
  19. ; Llenar la jarra de 8
  20.            (lambda (x) (if (< (jarra8 x) 8) (list (jarra5 x) 8) x))
  21.            
  22. ; Vaciar la jarra de 8
  23.            (lambda (x) (if (> (jarra8 x) 0) (list (jarra5 x) 0) x))
  24.            
  25. ; Volcar en la jarra de 8 todo el contenido de la jarra de 5 (que queda vacia)
  26.            (lambda (x) (if (>= (- 8 (jarra8 x)) (jarra5 x)) (list 0 (+ (jarra8 x) (jarra5 x))) x))
  27.            
  28. ; Llenar la jarra de 8 con parte del contenido de la jarra de 5
  29.            (lambda (x) (if (< (- 8 (jarra8 x)) (jarra5 x)) (list (- (jarra5 x) (- 8 (jarra8 x))) 8) x))
  30.            
  31.           )
  32. )
  33.  
  34. (defun jarra5 (x) (car x))
  35.  
  36. (defun jarra8 (x) (cadr x))
  37.  
  38. ;breadth.lsp
  39. (defun breadth-first (bc)
  40.     (princ "Ingrese el estado inicial: ") (setq inicial (read))
  41.     (princ "Ingrese el estado   final: ") (setq final (read))
  42.     (cond ((equal inicial final) (princ "El problema ya esta resuelto !!!") (terpri) (breadth-first))
  43.           (t (buscar bc final (list (list inicial)) nil))))
  44.  
  45. (defun buscar (bc fin grafobusq estexp)
  46. ;(terpri)
  47. ;(princ " Grafo: ") (princ grafobusq) (terpri)
  48. ;(princ "EstExp: ") (princ estexp) (terpri)
  49.     (cond ((null grafobusq) (fracaso))
  50.           ((pertenece fin (first grafobusq)) (exito grafobusq))
  51.           (t (buscar bc fin (append (rest grafobusq) (expandir (first grafobusq) bc estexp))
  52.                             (if (pertenece (first (first grafobusq)) estexp) estexp (cons (first (first grafobusq)) estexp))))))
  53.  
  54. (defun expandir (linea basecon estexp)
  55.     (if (or (null basecon) (pertenece (first linea) estexp)) nil
  56.       (if (not (equal (funcall (eval (first basecon)) (first linea)) (first linea)))
  57.           (cons (cons (funcall (eval (first basecon)) (first linea)) linea) (expandir linea (rest basecon) estexp))
  58.           (expandir linea (rest basecon) estexp))))
  59.  
  60. (defun pertenece (x lista)
  61.   (cond ((null lista) nil)
  62.         ((equal x (first lista)) t)
  63.         (t (pertenece x (rest lista)))))
  64.  
  65. (defun exito (grafobusq)
  66.     (princ "Exito !!!") (terpri)
  67.     (princ "Prof ....... ") (princ (- (length (first grafobusq)) 1)) (terpri)
  68.     (princ "Solucion ... ") (princ (reverse (first grafobusq))) (terpri) t)
  69.    
  70. (defun fracaso ()
  71.     (princ "No existe solucion") (terpri) t
  72. )
  73.  
  74. (print (breadth-first bc))
  75.  
  76. ;puzzle8.lsp
  77. ; Permite pasar, por ejemplo, de (0 1 2 5 6 3 4 7 8) a (1 2 3 4 5 6 7 8 0)
  78. ;
  79. ;      0 1 2       1 2 3
  80. ; De   5 6 3   a   4 5 6   moviendo siempre el 0
  81. ;      4 7 8       7 8 0
  82.  
  83.  
  84. (setq bc '(
  85.            (lambda (x) (if (= (item 1 x) 0) (intercambiar 1 2 x) x))
  86.            (lambda (x) (if (= (item 1 x) 0) (intercambiar 1 4 x) x))
  87.            (lambda (x) (if (= (item 2 x) 0) (intercambiar 2 1 x) x))
  88.            (lambda (x) (if (= (item 2 x) 0) (intercambiar 2 3 x) x))
  89.            (lambda (x) (if (= (item 2 x) 0) (intercambiar 2 5 x) x))
  90.            (lambda (x) (if (= (item 3 x) 0) (intercambiar 3 2 x) x))
  91.            (lambda (x) (if (= (item 3 x) 0) (intercambiar 3 6 x) x))
  92.            (lambda (x) (if (= (item 4 x) 0) (intercambiar 4 1 x) x))
  93.            (lambda (x) (if (= (item 4 x) 0) (intercambiar 4 5 x) x))
  94.            (lambda (x) (if (= (item 4 x) 0) (intercambiar 4 7 x) x))
  95.            (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 2 x) x))
  96.            (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 4 x) x))
  97.            (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 6 x) x))
  98.            (lambda (x) (if (= (item 5 x) 0) (intercambiar 5 8 x) x))
  99.            (lambda (x) (if (= (item 6 x) 0) (intercambiar 6 3 x) x))
  100.            (lambda (x) (if (= (item 6 x) 0) (intercambiar 6 5 x) x))
  101.            (lambda (x) (if (= (item 6 x) 0) (intercambiar 6 9 x) x))
  102.            (lambda (x) (if (= (item 7 x) 0) (intercambiar 7 4 x) x))
  103.            (lambda (x) (if (= (item 7 x) 0) (intercambiar 7 8 x) x))
  104.            (lambda (x) (if (= (item 8 x) 0) (intercambiar 8 7 x) x))
  105.            (lambda (x) (if (= (item 8 x) 0) (intercambiar 8 5 x) x))
  106.            (lambda (x) (if (= (item 8 x) 0) (intercambiar 8 9 x) x))
  107.            (lambda (x) (if (= (item 9 x) 0) (intercambiar 9 6 x) x))
  108.            (lambda (x) (if (= (item 9 x) 0) (intercambiar 9 8 x) x))
  109.           )
  110. )
  111.  
  112. (defun intercalar (x num lista)
  113.     (append (subseq lista 0 (- num 1)) (cons x (nthcdr (- num 1) lista))))
  114.  
  115. (defun cambiar (x num lista)
  116.     (intercalar x num (borrar num lista)))
  117.  
  118. (defun intercambiar (n1 n2 lista)
  119.     (cambiar (item n1 lista) n2 (cambiar (item n2 lista) n1 lista)))
  120.  
  121. (defun item (n lista)
  122.   (if (equal n 1) (first lista) (item (- n 1) (rest lista))))
  123.  
  124. (defun borrar (num lista)
  125.   (append (subseq lista 0 (- num 1)) (nthcdr num lista)))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top