Translate

jueves, 24 de mayo de 2018

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