Lisp: Código que encuentra la solución al juego de puzzle

1 Comment // Written on May 17, 2008 // General, Programación, Tecnológico

Ahí va otro código que desarrolle en IA. Busca la solución por el algoritmo Búsqueda profundidad del juego puzzle. El código esta hecho para Windows, y para ejecutarlo necesitas NewLisp y Mulisp que lo puedes descargar al final del post.

(define (Abajo E)
  (set 'b (find 0 E))
  (cond
   ((< (+ b 3) 9) (push (nth b E) E (+ b 3)) (pop E b)
   (push
   (pop E (+ b 3)) E b)
	(Actualiza E)))

  (print E))

  (define (Izquierda E)
  (set 'b (find 0 E))
  (cond
   ((= (= b 0) (= b 3) (= b 6) false) (push (nth b E) E (- b
      1))
    (pop E (+ b 1))
	(Actualiza E) 

	))
  (print E))

(define (Arriba E)
  (set 'b (find 0 E))
  (cond
   ((> (- b 3) 0) (push (nth b E) E (- b 3)) (pop E (+ b 1))
    (push (pop E (- b 2)) E b)
			(Actualiza E)
	))
  (print E))

  (define (Derecha E)
  (set 'b (find 0 E))
  (cond
   ((= (= b 2) (= b 5) (= b 8) false) (push (nth b E) E (+ b
      2))
    (pop E b)
	(Actualiza E)
	))
  (print E))

(define (Busca EI EM | Res)
  (set 'EdosTrat '())
  (set 'Res (BusAProf 1 EI EM Operadores))
  (if (not (empty? Res))
   (print Res)
   (print "\nNo hay solucion\n")))

   (define (BusAProf Nivel EA EM Ops | ROps OpActual Encontrado NE)
  (set 'ROps Ops)
  (set 'Encontrado '())
  (setq EdosTrat (cons EA EdosTrat))
  (while (and (not Encontrado) (not (empty? Ops)))
   (setq OpActual (first Ops))
   (setq Ops (rest Ops))
   (if (setq NE (eval (list OpActual (quote EA))))
    (cond
     ((= NE EM) (set 'Encontrado (list OpActual)))
     ((and (not (member NE EdosTrat)) (set 'Encontrado (BusAProf
         (+ Nivel 1) NE EM ROps)))
      (set 'Encontrado (cons OpActual Encontrado))))))Encontrado)

(set 'Operadores '(Arriba Izquierda Abajo Derecha))

(define (Solucion )
    (set 'E0 '())
  (set 'EF '())
	  (prop-color 'I1  254 254 254)
	  (prop-color 'I2  254 254 254)
	  (prop-color 'I3  254 254 254)
	  (prop-color 'I4  254 254 254)
	  (prop-color 'I5  254 254 254)
	  (prop-color 'I6  254 254 254)
	  (prop-color 'I7  254 254 254)
	  (prop-color 'I8  254 254 254)
	  (prop-color 'I9  254 254 254)
  (set 'E0 (append E0 (list
	(integer (prop-text 'I1))
     (integer (prop-text 'I2))
     (integer (prop-text 'I3))
     (integer (prop-text 'I4))
     (integer (prop-text 'I5))
     (integer (prop-text 'I6))
     (integer (prop-text 'I7))
     (integer (prop-text 'I8))
     (integer (prop-text 'I9)))))
		(set 'cero (+ (find 0 E0) 1))
		(eval-string (string (concat "(prop-color 'I" (string cero) " 200 200 200)")))
  (set 'EF (append EF (list
	(integer  (prop-text 'F1))
	 (integer (prop-text 'F2))
     (integer (prop-text 'F3))
     (integer (prop-text 'F4))
     (integer (prop-text 'F5))
     (integer (prop-text 'F6))
     (integer (prop-text 'F7))
     (integer (prop-text 'F8))
     (integer (prop-text 'F9)))))
  (prop-text 'S (string (Busca E0 EF))))
(define (Actualiza E)
  (set 'cero (+ (find 0 E) 1))
  (sleep 900)
	(prop-text 'I1 (string (nth 0 E)))
   (prop-text 'I2 (string (nth 1 E)))
   (prop-text 'I3 (string (nth 2 E)))
   (prop-text 'I4 (string (nth 3 E)))
   (prop-text 'I5 (string (nth 4 E)))
   (prop-text 'I6 (string (nth 5 E)))
   (prop-text 'I7 (string (nth 6 E)))
   (prop-text 'I8 (string (nth 7 E)))
   (prop-text 'I9 (string (nth 8 E)))
   (eval-string (string (concat "(prop-color 'I" (string cero) " 200 200 200)")))
)

(define (inicio )
  (text-font "Arial" -14 0)
  (win-dialog 'Dialogo 'console 150 150 520 300 "Tarea 2 ::: Puzzle")
  (win-label 'Texto1 'Dialogo 50 20 150 22 "ESTADO INICIAL")
  (win-label 'Texto2 'Dialogo 240 20 150 22 "ESTADO FINAL")
  (win-editline 'I1 'Dialogo 60 50 20 20 "1")
  (win-editline 'I2 'Dialogo 95 50 20 20 "1")
  (win-editline 'I3 'Dialogo 130 50 20 20 "1")
  (win-editline 'I4 'Dialogo 60 80 20 20 "1")
  (win-editline 'I5 'Dialogo 95 80 20 20 "1")
  (win-editline 'I6 'Dialogo 130 80 20 20 "1")
  (win-editline 'I7 'Dialogo 60 110 20 20 "1")
  (win-editline 'I8 'Dialogo 95 110 20 20 "1")
  (win-editline 'I9 'Dialogo 130 110 20 20 "0")
  (win-editline 'F1 'Dialogo 240 50 20 20 "1")
  (win-editline 'F2 'Dialogo 275 50 20 20 "1")
  (win-editline 'F3 'Dialogo 310 50 20 20 "1")
  (win-editline 'F4 'Dialogo 240 80 20 20 "1")
  (win-editline 'F5 'Dialogo 275 80 20 20 "0")
  (win-editline 'F6 'Dialogo 310 80 20 20 "1")
  (win-editline 'F7 'Dialogo 240 110 20 20 "1")
  (win-editline 'F8 'Dialogo 275 110 20 20 "1")
  (win-editline 'F9 'Dialogo 310 110 20 20 "1")
  (win-editline 'S 'Dialogo 40 170 400 22 "")
  (win-label 'Texto3 'Dialogo 40 150 150 22 "SOLUCION:")
  (win-pushbutton 'Solucion 'Dialogo 370 50 70 22 "Solución"
   'Solucion)
  (prop-enabled 'Aplicar 0))

(define-macro (local var-list)
  ((append '(lambda ) (list var-list) (rest (args local)))))

(define (opsys )
  (cond
   ((primitive? clear-console) 'windows)
   ((primitive? int86)
    (if (primitive? comm-read)
     'dos 'extender))
   ((primitive? registry-read) 'win32)
   (true 'unix)))

(define-macro (setq p1 p2)
  (set p1 (eval p2)))

Aquí es cuando te das cuenta de que la Inteligencia es de buscar… no de pensar(¿O buscar es pensar?).
Descargar newlisp.zip
Ver código en pastebin.com.

Lisp: Código parar convertir expresión infija a prefija

1 Comment // Written on Mar 16, 2008 // Programación, Tecnológico

Pues como prometí postear todo código que programara en IA, les dejo el primero. Sirve para convertir de inorden a preorden.

(set ‘OP ‘

(

(* 2)

(/ 2)

(+ 1)

(- 1)

)

)

(define (ordenaPreorden IN)

(INPRE IN ‘() ‘()))

(define (INPRE IN PRE PILA)

(cond

((or (empty? IN) (= nil IN) (not (list? IN)))

(append (reverse PILA) PRE)

)

(true (set ‘ULTIMO (last IN))

(begin

(cond

((list? (last IN))

(set ‘PRE (append (INPRE (last IN) ‘() ‘ ()) PRE))

)

( (integer? ULTIMO)

(set ‘PRE (cons ULTIMO PRE))

)

(true

( begin

(set ‘IN_OP (HAYOPERADOR (assoc ULTIMO OP)))

(set ‘OP_PILA (HAYOPERADOR (assoc (first PILA) OP)))

(cond

((<= IN_OP OP_PILA)

(set ‘TOPPILA (first PILA))

(set ‘PILA (rest PILA))

(set ‘PRE (cons TOPPILA PRE))

)

)

(set ‘PILA (cons ULTIMO PILA))

)

)

)

(INPRE (QUITARULTIMO IN) PRE PILA)

)

)

)

)

(define (QUITARULTIMO LISTA)

(reverse (rest (reverse LISTA)))

)

(define (HAYOPERADOR OP)

(cond

((not (list? OP)) 0)

(true

(first (rest OP))

)

)

)

Lisp es un lenguaje muy loco, cuesta un poco agarrarle la onda. Ya que uno piensa en un problema y ya sabe como resolverlo de manera estructurada, pero con Lisp es otro paradigma.