Crear un ejemplo de Sistema Experto Multiproposito

 En lisp es extremadamente sencillo generar sistemas expertos. Un sistema experto es un programa que resuelve problemas de un area especifica como medicina, ingenieria, etc, por citar ejemplos, tal como lo haría un humano experto en ese tema.
 Claro que para cargar los datos del programa necesitas que el experto humano ofrezca la informacion.
 La idea es generar un sistema experto que sirva para cualquier area, un esqueleto que dependa de la informacion que se cargue.
 Ok, basta de hablar y vamos a los bifes:

 Cada nodo tiene una lista de condiciones.
 Cada condicion consta de una funcion booleana que verifica un valor ingresado de una magnitud y el nombre de la variable
 de otro nodo al que ira en el caso que se cumpla dicha funcion.

(defun nueva-condicion (funcion sub-nodo)
  (setf lista (list funcion sub-nodo))
  lista)
 
 Un ejemplo de carga, en este caso se cargara un arbol de decision sobre condiciones de un supuesto paciente, aclaro que no se nada de medicina.

(setf nodo-1 nil)
(setf condicion (nueva-condicion '(> temperatura 39) 'nodo-1-1))
(push condicion nodo-1)

(setf condicion (nueva-condicion '(<= temperatura 25) 'nodo-1-2))
(push condicion nodo-1)

(setf condicion (nueva-condicion '(> presion 13) 'nodo-1-3))
(push condicion nodo-1)

(setf condicion (nueva-condicion '(< presion 6) 'nodo-1-4))
(push condicion nodo-1)

 Es necesario que todas las variables tengan un valor (que se hayan creado), por lo se da a temperatura y presion el valor nil:

(setf temperatura nil)
(setf presion nil)

 Los nodos terminales u hojas tienen cadenas de caracteres, son atomos.
 Claro que podrían contener tambien una lista de condiciones y los subnodos a su vez del mismo modo, pero este es un ejemplo
 sencillo.
(setf nodo-1-1 "Tiene fiebre")
(setf nodo-1-2 "Tiene hipotermia")
(setf nodo-1-3 "Hipertension")
(setf nodo-1-4 "Presion baja")

 Una regla fundamental para construir el arbol es que no haya nodos sin valor, o el programa fallara al ejecutarse.
 Hay que cargar todos los nodos en una variable global *db* para guardarlos luego:

(setf *db* nil)
(push nodo-1 *db*)
(push nodo-1-1 *db*)
(push nodo-1-2 *db*)
(push nodo-1-3 *db*)
(push nodo-1-4 *db*)

 Obviamente es un ejemplo simple, la complejidad depende de los datos que se cargan. Para guardar los
 nodos en disco, cargar y leer el teclado, tenemos las funciones:
(defun guardar (archivo)
  (with-open-file (out archivo
       :direction :output
       :if-exists :supersede)
  (with-standard-io-syntax
   (print *db* out))))

(defun cargar (archivo)
  (with-open-file (in archivo)
  (with-standard-io-syntax
   (setf *db* (read in)))))

(defun prompt-read (prompt)
  (format *query-io* "~a: " prompt)
  (force-output *query-io*)
  (read-line *query-io*))

  El programa que recorre el arbol de desicion creado es asi:

(defun recorre-arbol (nodo)
  (if (atom nodo)
      (princ nodo) ;si es un nodo terminal imprime la conclusion
    (loop ;si no es terminal recorre la lista de condiciones
     (if (not (null nodo))
(progn
   (setf condicion (pop nodo))
   (setf funcion (first condicion))
   (setf magnitud (second funcion))
   (when (null (eval magnitud)) ;Si magnitud no tiene ningun valor le pregunta al usuario
       (set magnitud (parse-integer (prompt-read magnitud)))) ;pregunta al usuario por el valor de la magnitud
;magnitud contiene a la variable en si, al usar set (no setf o setq) se activa
;la evaluacion y el valor leido se carga
;en la variable guardada en magnitud
     
   (when (eval funcion) ;evalua la funcion que se ha extraido
     (progn
       (setf sub-nodo (second condicion));obtiene el nodo al que ira
       (recorre-arbol (eval sub-nodo)); recursividad
       (return))));si ya ha entrado en la rama del arbol, no es necesario seguir recorriendo las condiciones
 
       (return)))));si ha terminado de recorrer las condiciones, termina el loop
     
 Para ocupar la funcion hacemos:
(recorre-arbol nodo-1);tiene que cargar el nodo raiz al comienzo

 Antes de salir hay que guardar los nodos en un archivo:
(guardar "nodos.dat")

 y para no tener que cargar todos los datos de nuevo al arrancar se hace:

(when (probe-file "nodos.dat")
  (cargar "nodos.dat"));si existe el archivo de nodos lo abre

 
 

Funciones (devolver valores)

Es muy sencillo, la función creada devolverá el último valor que se llama. Un ejemplo:

(defun maximo (a b)
    (if (> a b) (setf max a)
                     (setf max b))

    max)

Se puede devolver cualquier tipo de valor, según los tipos de variables que soporta el common lisp. Para utilizar el valor devuelto por la función:

(setf el-maximo (maximo 2 7)

Ahora bien, y observen la potencia del lenguaje, si quiero devolver múltiples valores, me conviene devolver una lista, que es un tipo nativo de nuestro lisp. Un ejemplo, en las ecuaciones de segundo grado hay dos raices posibles:


(defun segundo-grado (a b c)  ;ax^2 + bx + c = 0


    (setf det (- (expt b 2) (* 4 a c)))

    (setf x1 (/ (+ (- 0 b) (sqrt det))
                     (* 2 a)))
    (setf x2 (/ (- (- 0 b) (sqrt det))
                     (* 2 a)))

    (setf raices list x1 x2)
    raices)

Y devuelve una lista con dos elementos. Para usar los valores devueltos por esta función:

(setf lista (segundo-grado 1 2 3))
(setf x-1 (first lista))
(setf x-2 (second lista))
Que nos devuelve dos valores complejos para este caso.

Si una función devuelve múltiples valores en una lista, supongamos que devuelve ocho por ejemplo, debemos obtener los valores devueltos usando la función nth.





 

Programar en lisp desde tu celular (teléfono móvil o tablet)

Ok. Esto es fácil. Deberías descargar una app intérprete. Yo estoy usando CL REPL, descargada desde el google play store.

Otra opcion que me gusta es usar ECL sobre el emulador de terminal linux sobre android TERMUX. 

Primero debes instalar el TERMUX desde el Play Store. Debes darle permiso a la app para acceder al almacenamiento del dispositivo. Se hace desde configuracion/aplicaciones seleccionas la app TERMUX, vas a Accesos y activas la casilla de Almacenamiento. Ahora abres el TERMUX e instalas el ECL con el comando:

$ pkg install ecl

Te instalará el ECL. Para ejecutarlo simplemente escribes:

$ ecl

Algo muy importante es saber donde esta la carpeta de almacenamiento: "/storage/emulated/0/". Por ejemplo, si quiero cargar un archivo hola.lisp que se encuentra en la carpeta Descargas:

> (load "/storage/emulated/0/Download/hola.lisp")

Aunque es mas facil ingresar al directorio primero y despues ejecutar el ECL y cargar el archivo:

$ cd /storage/emulated/0/Download

$ ecl

...

> (load "hola.lisp")

Ok. :-) Espero que la información te haya sido de utilidad. Comenta. Saludos.

Macros

Se utilizan para generar código en lugar de realizar necesariamente algo.

Antes de comenzar con la macro voy a explicar algunas consideraciones sobre la sintaxis.

Una comilla hacia la izquierda (`) antes de cualquier expresión detiene la evaluación de la lista que le sigue del mismo modo que la comilla simple (')

> `(1 2 3)

(1 2 3)

> '(1 2 3)

(1 2 3)

Sin embargo, en la expresión que tiene la comilla hacia la izquierda, cualquier sublista precedida por una coma (,) será evaluada. Vea los efectos de la coma en la siguiente expresión:

> `(1 2 (+ 1 2))  

(1 2 (+ 1 2))

> `(1 2 ,(+ 1 2))  

(1 2 3)

Existe una variante de la coma (,) que es la coma con arroba (,@). Lo que hace ,@ es devolver los valores que se encuentran dentro de la lista que se devuelve, es decir la misma lista pero sin los parentesis. De esta manera se pueden "agregar" los valores devueltos a una lista que la contiene. Puedes ver la diferencia entre , y ,@ en las siguientes expresiones:

> `(and ,(list 1 2 3)) 

(AND (1 2 3))

> `(and ,@(list 1 2 3)) 

(AND 1 2 3)

También puedes usar ,@ para agregar valores en el medio de una lista:

> `(and ,@(list 1 2 3) 4) 

(AND 1 2 3 4)

Bien ;-) comencemos con la macro. Para crear una macro utilizamos defmacro.

(defmacro si-ocurre (condicion &rest cuerpo)

Si se verifica que "condicion" es verdad, la macro ejecuta las sentencias de "cuerpo".

Falta colocar que va a hacer la macro.

(defmacro si-ocurre (condicion &rest cuerpo)

    `(if ,condicion (progn ,@cuerpo) (format t "No puede conducir ~%")))

La coma (,) antes de "condicion" significa que la lista que se pasa como condicion será evaluada. La ,@ antes de "cuerpo" indica que se agregan las sentencias a la lista que la contiene, es decir, la lista con (progn s1 s2 ... sn), pues el argumento que se pasa a cuerpo es una lista de listas (s1 s2 ... sn)

Recordemos que &rest permite pasar un numero arbitrario de argumentos a la función o macro, y estos quedan dentro de una lista que los contiene. Por lo tanto "cuerpo" contendrá una lista de listas. 

Con esto se genera una nueva macro que recibe condiciones y ejecuta un cuerpo de sentencias. Bien, el poder de las macros permite que se escriba muy poco código para realizar un programa. Ademas hace mas claro el programa, evitando el uso de progn.

Probemos nuestra macro:

> (setf *edad* 16)

> (si-ocurre (>= *edad* 16) 

     (print "Ya tienes 16 años o mas")

     (print "Estas listo para conducir")

     (terpri))

"Ya tienes 16 años o mas")

"Estas listo para conducir"

Otra vez...

> (setf *edad* 15)

> (si-ocurre (>= *edad* 16) 

     (print "Ya tienes 16 años")

     (print "Estas listo para conducir")

     (terpri))

"No puede conducir"

Ok! .-) Saludos

Crear un ejecutable (portable)

Bien, esto es muy fácil. Vamos a usar SBCL (disponible en http://sbcl.org/platform-table.html) y LTK. Necesitamos primero crear la aplicación:

(defpackage :mi-programa

      (:use :common-lisp :ltk)

      (:export #:main))

(in-package :mi-programa)

(defun main ()

     (setf *debug-tk* nil)

     (with-ltk ()

          (let ((b (make-instance 'button

                                                 :text "Hola mundo!"

                                                  :command (lambda ()

                                                                                 (do-msg "Adios!")

                                                                                 (setf *exit-mainloop* t)))))

                 (place b 100 100))))

Hay que guardarlo, obviamente en un archivo de texto, yo lo guarde como: ventanita.lisp. (use el emacs para escribirlo). Correcto!, ahora hay que construir la aplicación, se puede usar un script, yo sin embargo prefiero hacerlo directamente en forma manual desde el intérprete del SCBL (aclaro que coloco la carpeta donde yo guarde mis archivos: "mis-programas")

> (compile-file "c:/mis-programas/ltk.lisp") ;hay que esperar que termine el proceso! :-) luego...

> (load "c:/mis-programas/ltk.fasl")

> (compile-file "c:/mis-programas/ventanita.lisp")

> (load "c:/mis-programas/ventanita.fasl")

> (save-lisp-and-die "c:/mis-programas/ventanita.core")

Si todo sale bien, el SCBL se cierra y se genera ventanita.core.

Hay que copiar el archivo sbcl.exe que se encuentra en la carpeta de instalación del programa en la carpeta donde esta "ventanita.core". Yo lo tengo en "C:\Program Files\Steel Bank Common Lisp\1.3.6>". Ahora hay que crear un archivo de proceso de lotes que invoca a nuestro pequeño programa de ejemplo. En el caso de Windows se crea un archivo de texto: ventanita.bat y se escribe en éste la siguiente línea:

sbcl --core ventanita.core --noinform --eval "(progn (mi-programa:main) (quit))"

Genial!!! Ahora solo hay que hacer doble click en nuestro archivo ventanita.bat para ejecutar el programa. También se puede crear un acceso directo a ventanita.bat!!! 

Para llevarlo a otra PC y ejecutarlo, solo necesitas tres archivos:

sbcl.exe

ventanita.core

ventanita.bat

Que podrían estar comprimidos en un solo .zip. 

Gracias por mirar y compartir este blog. Saludos y ojalá les guste la publicación.

Aclaración: Si tenemos alguna distribución linux, tenemos que crear un script con la extensión .sh y en las propiedades del archivo hay que activarlo como "archivo ejecutable". En la primera del script va: #! /bin/bash. Aquí hay una guía para generar scrpits en linux: http://www.escomposlinux.org/fserrano/index_163.html 

El archivo que necesitas en el caso de contar con linux se llama sbcl (a secas) para encontrarlo abre una terminal y tipea: which sbcl

Cargar una imagen en el canvas

Ok, ok, no se si vale la pena la publicación. Pero voy igual. Se pueden cargar imagenes dentro del canvas incluso fotos. Cargar gifs es sencillo, aqui muestro un ejemplo bastante tonto con una ventana y un botón para cargar la imagen.

Copie el texto de abajo en un archivo y guárdelo como "cargar-imagen.lisp" o como prefiera llamarlo. También puede descargarlo desde aquí: cargar-imagen.lisp. Obviamente debe descargar la imagen a cargar: test.gif . 

Y es necesario descargarse ltk.lisp indefectiblemente.

;-------------------------------------------------------------------------------------------------------------------------
(use-package :ltk)



(with-ltk() ; Ventana principal ---------------------------------
  (let*
      ((canvas (make-instance 'canvas))
       (boton (make-instance 'button :text "Cargar Imagen")))
 


    ; Eventos ---------------------------------------------------
    (bind boton "<Button-1>" (lambda (evento) ;carga una imagen en el canvas al presionar el boton
          (setf imagen (make-image)) ;crear imagen...
  (image-load imagen "~/Descargas/test.gif")
  (create-image canvas 0 0 :image imagen)))


    ; Configuraciones de widgets --------------------------------
 
    (configure canvas :width 100) ;tamaño del canvas
    (configure canvas :height 100)
   
    (minsize *tk* 280 280) ;detalles de la ventana
    (maxsize *tk* 280 280)
    (wm-title *tk* "Cargar imagen")

    (place canvas 50 50) ;ubicaciones de los widgets
    (place boton 100 200)))

;----------------------------------------------------------------------------------------------------------------------

Para ejecutarlo se necesita cargar primero ltk.lisp; y luego nuestro precioso programita:

> (load "~/Descargas/ltk.lisp")
> (load "~/Descargas/cargar-imagen.lisp")

Se mostrará el programa:

 Ojala le sea de utilidad. No olvide comentar. Saludos.

Listas de propiedades

Las listas de propiedades son parecidas a los registros en otros lenguajes. Lo que se llama "campos" para otros lenguajes en common lisp son propiedades.

Veamos unos ejemplos:

> (setf pelota '(:color "blanco" :diametro 25 :material "cuero"))

Pelota tiene distintas propiedades como color diámetro y material. Veamos otro:

> (setf mi-moto '(:marca "Zanella" :modelo "Custom Patagonian Eagle" :cilindrada 150 :kilometros 4000 :precio 12000))
(:MARCA "Zanella" :MODELO "Custom Patagonian Eagle" :CILINDRADA 150 :KM 4000 :PRECIO 12000)

Para obtener el valor de una propiedad, usamos la función getf:

> (getf mi-moto :modelo)
"Custom Patagonian Eagle"

La función getf nos devuelve el valor de la propiedad, para ser utilizadas como argumento de otra función o almacenarse en un símbolo (de todas formas, al almacenarse termina usándose como argumento de otra función: "setf")

> (setf modelo (getf mi-moto :modelo))

En modelo queda el valor "Custom Patagonian Eagle".

Para modificar un valor de la lista de propiedades usamos "setf" con "getf" a la vez. Supongamos que queremos modificar el precio de "mi-moto":

> (setf (getf mi-moto :precio) 13000)
13000

Ok! :-P Si consultamos ahora nuestra lista de propiedades, veremos:

> mi-moto
(:MARCA "Zanella" :MODELO "Custom eagle" :CILINDRADA 150 :KM 4000 :PRECIO 13000)

Se puede guardar cada lista de propiedades en una lista, para tener una base de datos sencilla, que podría guardarse en un archivo, y tener funciones para búsqueda y filtros, etc. Las posibilidades son infinitas.