Translate

martes, 29 de agosto de 2023

Redes Neuronales en Lisp

 En esta página se puede obtener la libreria "simple-neural-net", para usar redes neuronales en nuestro interprete lisp. 

Brevemente, porque supongo que si llegaste hasta aca, ya tenes una idea de esto. Las redes neuronales estan formadas por capas, y cada capa es un conjunto de nodos. Tenes una capa con las entradas, una capa con las salidas y una o varias capas que median entre ambas, (entradas y salidas) que son las capas ocultas. La red se entrena, definiendo que salidas obtener de acuerdo a las entradas suministradas. 

Se utilizan para detectar patrones en imagenes, sonidos tambien, para ajustar y obtener mejores valores para los coeficientes de variables en funciones de evaluacion para juegos, etc.

Esta libreria usa las librerias "cl-store" y "lparallel", que pueden instalarse usando quicklisp. Explicado en este mismo blog.

En la pagina del proyecto se explica muy bien las funciones, asi que solo me voy a limitar a comentar uno de los ejemplos mostrados alli, que entrena la red para que muestre en una salida los resultados de una funcion XOR, aplicado a dos entradas:


(asdf:load-system "simple-neural-network") ;; carga la libreria
(defun normalize (input)
  (map 'vector (lambda (x) (if (= x 1) 1.0d0 -1.0d0)) input))

(defun denormalize (output)
  (if (plusp (aref output 0)) 1 0))

(defvar inputs (mapcar #'normalize '(#(0 0) #(0 1) #(1 0) #(1 1)))) ;; define las entradas
(defvar targets (mapcar #'normalize '(#(0) #(1) #(1) #(0)))) ;; define cada resultado de salida que corresponde con cada entrada
(defvar nn (snn:create-neural-network 2 1 4)) ;; define una red neuronal con una capa de entrada de 2 nodos, una capa de salida de 1 nodo y una capa oculta de 4 nodos.
(dotimes (i 1000)
  (snn:train nn inputs targets 0.1)) ;; entrena la red 

(denormalize (snn:predict nn (normalize #(0 0))))
-> 0 ;; devuelve el valor de salida correspondiente, con la red ya entrenada

(denormalize (snn:predict nn (normalize #(1 0))))
-> 1

(denormalize (snn:predict nn (normalize #(0 1))))
-> 1

(denormalize (snn:predict nn (normalize #(1 1))))
-> 0

sábado, 12 de marzo de 2022

CLOS (Common Lisp Object System)

En CLOS la macro defclass define una clase, defmethod define un método, y make-instance crea una instancia de una clase: un objeto. La forma general de la macro defclass es: 

(defclass nombre-clase (superclase...) (campos...) optional-opciones-clase...) 

Las opciones de clase rara vez son usadas. defclass puede ser usado para definir la clase cuenta:

(defclass cuenta () 

          ((nombre :initarg :nombre :reader nombre) 

           (balance :initarg :balance :initform 0.00 :accessor balance) 

           (tasa-interes :allocation :class :initform .06 :reader tasa-interes)))                                                                            

En la definición de 'cuenta', vemos que la lista de superclase esta vacía, debido a que 'cuenta' no hereda de ninguna clase. Hay tres campos, para nombre, balance y tasa-interes. Cada campo puede ser seguido por pares opcionales que definen como sera usado este. El campo nombre tiene la opción :initarg, que informa que el nombre puede ser especificado cuando se crea una 'cuenta' nueva con make-instance. La opción :reader crea un método nombre para obtener el valor actual del campo. El campo balance tiene tres opciones. :initarg, informando que el balance puede ser especificado cuando la cuenta es creada; :initform, que informa que si el balance no esta especificado toma el valor por defecto 0.00 y : accessor, que crea un método para obtener el valor del campo tal como :reader lo hace, y también crea un método para actualizar el campo con setf. El campo tasa-interes tiene una opción :initform para establecer un valor por defecto y una opcion :allocation que informa que este campo es parte de la clase, no de cada instancia de clase.

Aquí vemos la creación de un objeto, y la aplicación de los métodos definidos para él:

> (setf a1 (make-instance 'cuenta :balance 5000.00 

     :nombre "Akkiz"))  

#<CUENTA 26726272> 

                        

> (nombre a1)  

"Akkiz" 

                        

> (balance a1)  

5000.0 


> (tasa-interes a1)  

0.06 

CLOS difiere de la mayoría de los sistemas orientados a objetos en que los métodos son definidos de forma separada de las clases. Para definir un método (además de las definidas automáticamente por las opciones :reader, :writer o :accessor) usaremos la macro defmethod. Esta es similar en forma a defun:

(defmethod nombre-metodo (parametros...) cuerpo...) 

Los parámetros requeridos para un defmethod pueden ser de la forma (var clase), siendo este un método que aplica solo para argumentos de esa clase. Aquí mostramos el método para extraer dinero de una cuenta. Observe que CLOS no tiene una noción de variables de instancia, solo campos de instancia. Así tenemos que usar el método (balance cta) en lugar de la variable de instancia balance:

(defmethod retirar ((cta cuenta) monto) 

  (if (< monto (balance cta)) 

      (decf (balance cta) monto) 

      'fondos-insuficientes))

Con CLOS es fácil definir una cuenta-limitada como una subclase de cuenta, y definir el método extraer para cuenta-limitada:

(defclass cuenta-limitada (cuenta) 

  ((limite :initarg :limite :reader limite)))

           

(defmethod retirar ((cta cuenta-limitada) monto)                                                         

  (if (> monto (limite cta)) 

       'limite-superado 

       (call-next-method))) 

Observe el uso de call-next-method para invocar al método retirar de la clase cuenta. Observe también que todos los otros métodos para cuentas automáticamente funcionarán sobre instancias de la clase cuenta-limitada, debido a que ésta es definida por herencia de cuenta. En el siguiente ejemplo, mostramos que el método nombre es heredado, que método retirar para cuenta-limitada es invocado primero, y que el método retirar para cuenta es invocado a través de la función call-next-method:

> (setf a2 (make-instance 'cuenta-limitada

      :nombre "Ebru Sahin" 

      :balance 500.00 

      :limite 100.00))  

#<CUENTA-LIMITADA 24155343> 

  

> (nombre a2)  

"Ebru Sahin" 

  

> (retirar a2 200.00) 

LIMITE-SUPERADO 

  

> (retirar a2 20.00)  

480.0 

En general, hay varios métodos apropiados para un mensaje. En ese caso, todos los métodos apropiados se disparan juntos y se ordenan, el mas específico va primero. Un método menos específico que el anterior es llamado luego, y así sucesivamente. De este modo el método para cuenta-limitada es llamado primero antes que el método para cuenta. La función call-next-method puede ser usada dentro del cuerpo de un método para llamar al próximo método mas específico. La historia completa es aun mas complicada. Como ejemplo de esto, considere la clase cuenta-revisada, que muestra y mantiene una auditoría de todos los depósitos y extracciones. Esta podría ser definida usando una característica de CLOS, los métodos :before y :after. ("antes" y "después").      

(defclass cuenta-revisada (cuenta) 

  ((auditoria :initform nil :accessor auditoria))) 

           

(defmethod retirar :before ((cta cuenta-revisada) monto) 

  (push (print `(debito ,monto)) 

        (auditoria cta))) 

           

(defmethod retirar :after ((cta cuenta-revisada) monto) 

  (push (print `(debito (,monto) hecho)) 

        (auditoria cta)))    

Ahora una llamada a retirar con una cuenta-revisada como el primer argumento tiene tres métodos aplicables: el método primario de cuenta y los métodos :before y :after. Aquí un ejemplo: 

> (setf a3 (make-instance 'cuenta-revisada :balance 1000.00)) 

#<CUENTA-REVISADA 33555607> 

  

> (retirar a3 100.00) 

(DEBITO 100) 

(DEBITO (100) HECHO) 

900.0 

  

> (auditoria a3) 

((DEBITO (100) HECHO) (DEBITO 100)) 


> (setf (auditoria a3) nil) 

NIL 



  

miércoles, 9 de marzo de 2022

Sistemas expertos: MYCIN

 Hola amigos, traduje el programa mycin comentado en el libro "Paradigmas de inteligencia artificial" de Peter Norvig al español (pag. 530). 

Los comandos mas usados son:

?: muestra los posibles valores.

por-que?: explica por que pide un dato.








Aqui un ejemplo de su ejecucion:                                                                            

>> (mycin)

------ PACIENTE-1 ------

Nombre del paciente:  Silvia Saint

Sexo: femenino

Edad: 29

------ CULTIVO-1 ------

Que tipo de cultivo fue extraido de CULTIVO-1? sangre

Hace cuantos dias fue extraido este cultivo de (CULTIVO-1) ? 4

------ ORGANISMO-1 ------

Ingrese la identidad (genero) de ORGANISMO-1: desconocido

El tinte de gram de ORGANISMO-1: ?

Un GRAM debe ser del tipo (MEMBER ACID-FAST POS NEG)

El tinte de gram de ORGANISMO-1: neg

Es ORGANISMO-1 bacilo o coco (etc.): bacilo

Cual es el AEROBICIDAD de ORGANISMO-1? por-que?

[Por que el valor de AEROBICIDAD es preguntado?]

Es sabido que:

 1) LA GRAM DEL ORGANISMO ES NEG

 1) LA MORFOLOGIA DEL ORGANISMO ES BACILO

Por lo tanto,

Regla 107:

 Si

 1) LA AEROBICIDAD DEL ORGANISMO ES AEROBICO

 Entonces hay evidencia (0.8) de que

 1) LA IDENTIDAD DEL ORGANISMO ES ENTEROBACTERIACEAE

Cual es el AEROBICIDAD de ORGANISMO-1? aerobico

Esta Silvia Saint comprometido? si

Es Silvia Saint un pacente quemado? Si es asi, es leve o grave? grave

Hallazgos para ORGANISMO-1:

 IDENTIDAD: ENTEROBACTERIACEAE (0.800)  PSEUDOMONAS (0.760)

Hay otro ORGANISMO?  (Y or N) y

------ ORGANISMO-2 ------

Ingrese la identidad (genero) de ORGANISMO-2: desconocido

El tinte de gram de ORGANISMO-2: (neg .8 pos .2)

Es ORGANISMO-2 bacilo o coco (etc.): bacilo

Cual es el AEROBICIDAD de ORGANISMO-2? anaerobico

Hallazgos para ORGANISMO-2:

 IDENTIDAD: BACTEROIDES (0.720)  PSEUDOMONAS (0.646)

Hay otro ORGANISMO?  (Y or N) n

Hay otro CULTIVO?  (Y or N) n

Hay otro PACIENTE?  (Y or N) n

NIL    

      

  

jueves, 6 de mayo de 2021

Tablas Hash en Lisp

 Las tablas hash guardan datos de la forma (clave valor). Se usan para guardar grandes cantidades de registros, donde la lectura de un registro se hace de forma muy rapida, sin importar el tamaño de la tabla. 

Para crear una tabla hash usamos:

(setf *mi-tabla* (make-hash-table))

Tanto para generar un registro como para leer se usa la funcion gethash en la forma (gethash clave *tabla-hash*)

Para crear registros:     

(setf (gethash 'clave1 *mi-tabla*) "arbolito")

(setf (gethash 'clave2 *mi-tabla*) "manteca")

(setf (gethash 'clave3 *mi-tabla*) "crema pastelera")

Para lectura:

(setf valor (gethash 'clave2 *mi-tabla*))

"manteca"

La funcion maphash permite aplicar una funcion especifica a cada par clave/valor de una tabla hash:

(maphash #'(lambda (clave valor) 

                (format t "~&~a --> ~a" clave valor)) 

         *mi-tabla*)         

CLAVE3 --> crema pastelera

CLAVE1 --> arbolito

CLAVE2 --> manteca

La clave siempre debe ser un simbolo. Si hay alguna duda le preguntamos al Peluca



Por ultimo veremos como guardar y leer desde el almacenamiento, porque no lo vi en todo el internet.

Usaremos las siguientes funciones:


(defun guardar (archivo dato)

  (with-open-file (out archivo

         :direction :output

         :if-exists :supersede)

    (with-standard-io-syntax

     (print dato out))))


(defun cargar (archivo)

  (with-open-file (in archivo)

    (with-standard-io-syntax

     (read in))))

     

Ok, para guardar en un archivo, aclaro que en ejemplo omito la carpeta donde guardo:                               

(guardar "tabla.dat" *mi-tabla*)


Ahora a cerrar el entorno de desarrollo, y lo abrimos nuevamente para probar la carga: (en la misma carpeta donde guardamos)                                                      

(setf *mi-tabla* (cargar "tabla.dat")


En algunas plataformas para usar ciertas carpetas debes tener permisos de administrador, root o superusuario, asi que asegurate que la carpeta usada no necesita permisos de lectura/escritura.  .-)   

lunes, 26 de abril de 2021

Ajedrez: algoritmos de busqueda

 Hola amigos. Dejo el enlace pet-rock-chess de un juego de ajedrez hecho en lisp. El objeto de mostrarlo es puramente educativo, pues las funciones de evaluacion que tiene son muy basicas. En el se muestran los algoritmos minimax y el alfa-beta. 

Por ejemplo, para un juego entre dos estrategias de ordenador distintas a 1 min:

> (ajedrez #'random-estrategia (alfa-beta-searcher3 1 #'combina-eval) t 1 )

Donde la profundidad de busqueda del alfa-beta es a un solo nivel. La funcion de evaluacion es combina-eval. El jugador blanco siempre va primero, el negro segundo. Otro ejemplo, un juego de 5 min entre un humano y el ordenador con una profundidad de busqueda de 2 niveles:

> (ajedrez #'humano (alfa-beta-searcher3 2 #'combina-eval) t 5 )

Para jugar cuando le toca a humano debera escribir, por ejemplo: 

(caballo-blanco b1 c3)

Obviamente que no tiene una interfaz grafica aun. Un ejemplo mas: busqueda minimax y busqueda alfa-beta, a un min y con distintas funciones de evaluacion: 

(ajedrez (minimax-searcher 1 #'movilidad) (alfa-beta-searcher3 1 #'movilidad-contraria) t 1)

Saludos ;-)

lunes, 1 de junio de 2020

Inteligencia Artificial: Creacion de herramientas de software



Hola amigos. Sigo traduciendo el libro de Peter Norvig. Dejo el link del libro en ingles (Esta en formato djvu). Si alguien quiere ayudarme con la traduccion, me avisa y lo agrego como colaborador. Aqui dejo el enlace con el archivo.lisp que tiene las funciones tratadas en esta entrada.

En las secciones anteriores vimos lo comcerniente a dos programas particulares SGP y ELIZA. Ahora volveremos a examinar estos dos programas para descubrir algunos patrones comunes. Estos patrones seran abstraidos en forma de herramientas de software reutilizable que seran de gran ayuda en los capitulos siguientes.

Un interprete interactivo


La estructura del programa eliza es comun. La repetimos abajo:

(defun eliza ()
  "Responde a la entrada del usuario usando reglas de coincidencia de patrones."
  (loop
      (print 'eliza>)
      (print  (aplanar (usar-reglas-eliza (read *query-io*))))))


Muchas otras aplicaciones usan este patron, incluido el mismo Lisp. El terminal lisp podria ser definido asi:

(defun lisp ()
   (loop
      (print '>)
      (print (eval (read)))))


El terminal del sistema lisp historicamente ha sido llamado como el bucle "read-eval-print". La mayoria de los Lisp modernos imprimen un prompt antes de leer la entrada, de esta manera deberia ser realmente llamado el bucle "prompt-read-eval-ptint", pero no habia prompt en algunos sistemas anteriores como MacLisp, y entonces el nombre quedaba mucho mas corto. Si no queremos usar el prompt, podriamos escribir un interprete lisp completo usando solo cuatro simbolos:

(loop (print (eval (read))))


Puede parecer gracioso decir que esos cuatro simbolos y ocho parentesis constituyen un interprete lisp. Cuando escribimos esa linea ¿realmente hemos cumplido con todo? Una respuesta a esa cuestion es considerar que podriamos tener que escribir un interprete lisp (o Pascal) en Pascal. Podriamos necesitar un analizador lexico y un administrador de tabla de simbolos. Esto es una considerable cantidad de trabajo, pero todo es manejado por read. Necesitariamos un analizador sintactico para ensamblar los simbolos lexicos dentro de las declaraciones. read tambien maneja esto, pero solo porque las declaraciones Lisp tienen una sintaxis trivial: la sintaxis de listas y atomos. De esta manera read sirve bien como un analizador sintactico para lisp, pero fallaria para Pascal. Luego necesitaremos la parte de evaluacion o interṕretacion del interprete; eval hace esto de manera amigable, y podria manejar Pascal solo como si interpretaramos sintaxis Pascal dentro de sentencias Lisp. print hace mucho menos trabajo que read o eval, pero sigue siendo practica. 
El punto importante no es que una linea de codigo pueda ser considereda una implementacion de Lisp, sino reconocer patrones comunes de computacion. Tanto Eliza como Lisp pueden ser vistos como interpretes interactivos, que leen una entrada, evaluan o tansforman la entrada de alguna manera, imprimen el resultado y luego vuelven a pedir otra entrada. Podemos extraer los siguientea patrones comunes:


(defun programa
   (loop 
         (print prompt)
         (print (transformar (read)))))


Hay dos naneras de hacer uso de los patrones recursivos: formalmente e informalmente. La alternativa informal es tratar los patrones como un cliche o idioma que ocurre frecuentemente en nuestra escritura de programas pero que variara de uso en uso. Cuando queremos escribir un nuevo programa, recordamos escribir o leer uno similar, vamos para atras y miramos el primer programa, copiamos las secciones relevantes y luego las modificamos para el nuevo programa. Si el borrador es extenso, seria una buena idea insertar comentarios en el nuevo programa, citando al original, pero no habria una conexion "oficial" entre el programa original y su derivado.
La alternativa formal es crear una abstraccion en la forma de funciones y tal vez esrtructuras, y nos referimos explicitamente a esa abstraccion en cada nueva aplicacion -en otras palabras capturamos la abstraccion en la forma de una herramienta de software. El patron interprete puede ser abstraido en una funcion asi:


(defun interprete-interactivo (prompt transformacion)
  "Lee una expresion, la transforma e imprime el resultado"
  (loop
     (print prompt)
     (print (funcall transformacion (read)))))


Esta funcion podria ser usada luego en la escritura de cada nuevo interprete:

(defun lisp()
   (interprete-interactivo '> #'eval))   


(defun eliza ()  
   (interprete-interactivo 'eliza> #'(lambda(x) (aplanar (usar-reglas-eliza x)))))


O con la ayuda de la funcion de alto nivel "compuesta":

(defun compuesta (f g)
  "Devuelve la funcion que calcula (f (g x))"
  #'(lambda(x) (funcall f (funcall g x))))


(defun eliza ()  
   (interprete-interactivo 'eliza> (compuesta #'aplanar #'usar-reglas-eliza)))


Nota del T: vaya despacio...!, pasar funciones como argumentos y escribir funciones que devuelven funciones, son algunas de las caracteristicas potentes de lisp, pero no estamos acostumbrados generalmente a programar de esa manera.

Hay dos diferencias entre los enfoques formal e informal. En primer lugar lucen diferente. Si la abstraccion es simple, como esta, es probablemente mas facil leer una expresion que tuvo el bucle (loop) explicitamente escrito que leer una que llama a interprete-interactivo, ya que requiere buscar la definicion de interprete-interactivo y entenderla. La otra diferencia nos muestra lo que denominamos el mantenimiento. Suponga que buscamos una caracteristica perdida en la definicion del interprete interactivo. Una cuya omision haga que el bucle (loop) no termine. Tengo asumido que el usuario puede terminar el bucle provocando alguna tecla de interrupcion (break o abort). Una implementacion simple permitiria al usuario dar un comando de finalizacion explicito. Otra caracteristica util seria el manejo de errores dentro del interprete. Si usamos el enfoque informal, agregar una caracteristica a un programa no tendria efecto sobre los otros. Pero si usamos el enfoque formal, perfeccionar interprete-interactivo automaticamente traeria las nuevas caracteristicas para todos los programas que lo usan. La siguiente version de interprete-interactivo agrega dos nuevas caracteristicas. Primero utiliza la macro handler-case para manejar errores. Esta macro evalua su primer argumento, y normalmente solo devuelve ese valor. Sin embargo, si ocurre un error, los argumentos posteriores son chequeados por una condicion de error que coincide con el error ocurrido. En este uso, el caso error coincide con todos los errores, y la accion tomada es imprimir la condicion de error y continuar. Esta version tambien permite al prompt ser tanto una cadena de caracteres como una funcion sin argumentos que sera llamada para imprimir el prompt. La funcion prompt-generador, por ejemplo, devuelve una funcion que imprimira el prompt de la forma [1], [2], etcetera.

(defun interprete-interactivo (prompt transformacion)
  "Lee una expresion, la transforma e imprime el resultado"
  (loop
    (handler-case
      (progn
        (if (stringp prompt)
            (print prompt)
            (funcall prompt))
         (print (funcall transformacion (read))))
      ;; en caso de error hacer esto:
      (error (condicion)
             (format t "~&;; Error: ~a ignorado, regrese al terminal."
                       condicion)))))

(defun prompt-generador (&optional (num 0) (cont-cad "[~d] "))
  "Devuelve una funcion que imprime el prompt de la forma [1],[2],etc."
  #'(lambda () (format t cont-cad (incf num))))

Una herramienta de coincidencia de patrones

La funcion patron-coincide fue una funcion de coincidencia de patrones hecha especificamente para el programa ELIZA. Los programas subsiguientes necesitaran concidencia de patrones tambien, y antes que escribir funciones especificas para cada nuevo programa es mas facil definir uno general que pueda cubrir la mayoria de las necesidades y sea extensible para cubrir las nuevas necesidades. El problema de diseñar una herramienta general es decidir que caracteristicas proveera. Podemos definir caracteristicas que sean utiles, pero es tambien una buena idea hacer la lista de caracteristicas abierta, asi que una nueva puede ser agregada facilmente cuando sea necesario. Las caracteristicas pueden ser agregadas por generalizacion o especializacion. Por ejemplo, si proveemos variables de segmento que coinciden con cero o mas elementos de entrada. Podemos especializar esto proveyendo un tipo de variable de segmento que hace coincidir uno o mas elementos o para una variable opcional que hace coincidir cero o un elemento. Otra posibilidad es generalizar las variables de segmento para especificar una coincidencia de m a n elementos. Esas ideas vienen de la experiencia con notaciones para la escritura de expresiones regulares, asi como de la heuristica general para la generalizacion, tal como "considerar importante a los casos especiales" y "cero y uno son considerados como importantes casos especiales".

Otra caracteristica util es permitir al usuario especificar un predicado arbitrario que debe satisfacer la coincidencia. La notacion (?es ?n numberp) seria usada para coincidir cualquier expresion que ed un numero y buscarla para la variable ?n. Esto luciria como:

> (patron-coincide '(x = (?es ?n numberp)) '(x = 34))
((?N . 34))

> (patron-coincide '(x = (?es ?n numberp)) '(x = x))
NIL

Debido a que los patrones son como expresiones booleanas, esto hace que construyamos operadores booleanos en ellos. Siguiendo la convencion del signo de pregunta, usaremos ?and ?or y ?not * para los operadores.

* Una alternativa podria ser reservar el signo de pregunta para las variables solamente y usar otra notacion para estos operadores. Las claves podrian ser una buena opcion, tales como :and, :or, :es, etc.

Se muestra a continuacion un patron que hace coincidir una expresion relaciomal con una de las tres relaciones. Esto tiene exito porque el < coincide con una de las tres posibilidades especificadas por (?or < = >).

> (patron-coincide '(?x (?or < = >) ?y) '(3 < 4)
((?Y . 4) (?X . 3))

A continuacion se muestra un ejemplo de un patron ?and que chequea si una expresion es un numero y ademas es impar.

> (patron-coincide '(x = (?and (?es ?n numberp) (?es ?n oddp)))
'(x = 3))
((?N . 3))

El patron siguiente usa ?not para comprobar que dos partes no son iguales:

> (patron-coincide '(?x =/ (?not ?x)) '(3 =/ 4))
((?X . 3))

Hemos visto antes la notacion de coincidencia de segmentos. Esta es aumentada para permitir tres posibilidades: cero o mas expresiomes, una o mas expresiones y cero o una expresion. Finalmente la notacion (?if exp) puede ser usada para probar ina relacion entre algunas variables. Es mejor que esten listadas como un patron de segmento antes que un patron simple debido a que de ese modo no consumen cualquiera de las entradas en todas:

> (patron-coincide '(?x > ?y (?if (> ?x ?y))) '(4 > 3))
((Y . 3) (X . 4))

Cuando la descripcion de un problema es complicada es una buema idea intentar una especificacion mas formal. La siguiente tabla describe una gramatica de patrones, usando las mismas reglas gramaticales descritas en el capitulo 2.

pat => var coincide con cualquier expresion
constante solo coincide este atomo
segmento-pat coincide con alguna secuencia
simple-pat coincide con alguna expresion
(pat . pat) coincide el primero y el resto
simple-pat => (?es var predicado) verifica el predicado en una expresion
(?and pat...) coincide con todos los patrones en una expresion
(?or pat...) coincide con cualquier patron en una expresion
(?not pat...) es exitosa si el/los patron/es no coincide/n
segmento-pat => ((?* var) ...) coincide con cero o mas expresiones
((?+ var) ...) coincide con una o mas expresiones
((?? var) ...) coincide con cero o una expresion
((?if exp) ...) verifica si se cumple exp (que puede
contener variables
var => ?caracteres un simbolo que comienza con ?
constante => atom cualquier atomo que no sea una
variable

A pesar de la complejidad agregada todos los patrones pueden ser clasificador en cinco casos. Los patrones deben ser variable, constante, un patron de segmento (generalizado), un patron simple (generalizado) o una lista de dos patrones. La siguiente definicion de patron-coincide refleja los cinco casos (con dos verificaciones para fallas):

(defun patron-coincide (patron entrada &optional (enlaces sin-enlaces))
"Coincidencia de patrones preparando la entrada en el ambito de los enlaces"
(cond ((eq enlaces falla) falla)
((variable-p patron)
(coincidir-variable patron entrada enlaces))
((eql patron entrada) enlaces)
((segmento-patron-p patron)
(segmento-coincide patron entrada enlaces))
((simple-patron-p patron) ;***
(simple-coincide patron entrada enlaces)) ;***
((and (consp patron) (consp entrada))
(patron-coincide (rest patron) (rest entrada)
(patron-coincide (first patron) (first entrada)
enlaces)))
(t falla)))

Para completar, repetimos aqui las constantes y las funciones de bajo nivel de ELIZA:

(defconstant falla nil "Indica que patron-coincide falla")
(defconstant sin-enlaces '((t . t))
"Indica el exito de patron-coincide, sin variables.")

(defun variable-p (x)
"x es una variable? (un simbolo que comienza con '?')"
(and (symbolp x) (equal (char (symbol-name x) 0) #\?)))

(defun obtener-enlace(var enlaces)
"Busca un par (variable . valor) en una lista de enlaces."
(assoc var enlaces))

(defun enlace-var(enlace)
"Obtiene la variable de un enlace."
(car enlace))

(defun enlace-val(enlace)
"Obtiene el valor de un enlace."
(cdr enlace))

(defun crear-enlace (var val) (cons var val))

(defun buscar(var enlaces)
"Obtiene el valor (para var) de una lista de enlaces."
(enlace-val (obtener-enlace var enlaces)))

(defun extender-enlaces(var valor enlaces)
"Agrega un par (var . value) a la lista de enlaces."
(cons (cons var valor)
;; Una vez que agregamos un enlace "real",
;; podemos eliminar el tonto sin-enlaces
(if (eq enlaces sin-enlaces)
nil
enlaces)))

(defun coincidir-variable (var entrada enlaces)
"Coincide VAR con entrada? Usa (o actualiza) y devuelve los enlaces."
(let ((enlace (obtener-enlace var enlaces)))
(cond ((not enlace) (extender-enlaces var entrada enlaces))
((equal entrada (enlace-val enlace)) enlaces)
(t falla))))

El siguiente paso es definir los predicados que reconocen segmentos generalizados, los patrones simples y las funciones de coincidencia que operan en ellos. Podriamos implementar segmento-coincide y simple-coincide con declaraciones que consideran todos los casos posibles. Sin embargo podria ser dificil extender estas funciones. Un programador que quiere agregar un nuevo tipo de patrones de segmento tendria que editat las definiciones de ambos segmento-coincide y simple-coincide para instalar la nueva caracterisitica. Esto en si mismo, ouede no ser muy malo, pero considere que pasa cuando dos programadores agregan caracteristicas de manera independientemente. Si quieres usar ambos, ninguna de las versiones de segmento-coincide (o simple coincide) funcionará. Tendras que editar todas lss funciones nuevamente solo para mantener las dos extensiones.
La solucion para este dilema es escribir una version de segmento-coincide, de una vez por todas, pero teniendo esas funciones referidas a una tabla de pares patron/accion. La tabla diria, "si tu ves ?* en el patron, entonces usa segmento-coincide" y asi sucesivamente. Luego, programadores que quieren extender esta funcion solo deben agregar entradas a la tabla. Y esto es trivial para mantener diferentes extensiones (sin tener en cuenta, por supuesto, que dos programadores hayan elegido exactamente los mismos simbolos para realizar distintas acciones).
Este estilo de programacion, donde los pares patron/accion son almacenados en una tabla, es llamada "programacion conducida por datos". Este es un estilo muy flexible que es apropiado para escribir sistemas extensibles.
Hay muchas maneras de implementsr tablas en Common-lisp, como due tratado en la seccion 3.6 en la pagina 73. En este caso, las claves de la tabla seran los símbolos (como ?*), y eso esta bien si la representación de la tabla esta distribuida en la memoria. De esta manera las listas de propiedades son una opcion apropiada. Tendremos dos tablas, representadas por la propiedad segmento-coincide y la propiedad simple-coincide de simbolos como ?*. El valor de cada propiedad será el nombre de la función que implementa la coincidencia. Aqui tenemos las entradas de la tabla para implementar la gramática listada previamente.

(setf (get '?es 'simple) 'funcion-es)
(setf (get '?and 'simple) 'funcion-and)
(setf (get '?or 'simple) 'funcion-or)
(setf (get '?not 'simple) 'funcion-not)

(setf (get '?* 'segmento) 'segmento)
(setf (get '?+ 'segmento) 'segmento+)
(setf (get '?? 'segmento) 'segmento?)
(setf (get '?if 'segmento) 'funcion-if)

Con la tabla definida, necesitamos hacer dos cosas. Primero definimos el "pegamento" que mantiene la tabla unida: las funciones de predicado y acción tomada. Una función que luce como una función conducida por datos y la llama (tales como segmento-coincide y simple-coincide), es llamada una funcion de reparto.

(defun segmento-patron-p (patron)
"Es este un patron de coincidencia de segmento?: (?* var) . pat)"
(and (consp patron) (consp (first patron))
(symbolp (first (first patron)))
(segmento-funcion (first (first patron)))))

(defun simple-patron-p (patron)
"Es este un patron de coincidencia simple?
Ej. (?es x predicado) (?and . patrones) (?or . patrones)"
(and (consp patron)
(simple-funcion (first patron))))

(defun segmento-coincide (patron entrada enlaces)
"Llama a la funcion correcta para este tipo de patron de segmento."
(funcall (segmento-funcion (first (first patron)))
patron entrada enlaces))

(defun simple-coincide(patron entrada enlaces)
"Llama a la funcion correcta para este tipo de patron simple"
(funcall (simple-funcion (first patron))
(rest patron) entrada enlaces))

(defun segmento-funcion (x)
"Obtener la funcion de segmento para x,
si este es un simbolo que tiene una"
(when (symbolp x) (get x 'segmento)))

(defun simple-funcion (x)
"Obtener la funcion simple para x"
(when (symbolp x) (get x 'simple)))

La ultima cosa para hacer es definir las funciones individuales de coincidencia. Primero las funciones de coincidencia de simple-patron:

(defun funcion-es (var-y-pred entrada enlaces)
"Aprueba y enlaza var si la entrada satisface pred,
donde var-y-pred es la lista (var pred)."
(let* ((var (first var-y-pred))
(pred (second var-y-pred))
(nuevos-enlaces (patron-coincide var entrada enlaces)))
(if (or (eq nuevos-enlaces falla)
(not (funcall pred entrada)))
falla
nuevos-enlaces)))

(defun funcion-or (patrones entrada enlaces)
"Tiene exito si alguno de los patrones coinciden con la entrada"
(if (null patrones)
falla
(let ((nuevos-enlaces (patron-coincide
(first patrones)
entrada enlaces)))
(if (eq nuevos-enlaces falla)
(funcion-or (rest patrones) entrada enlaces)
nuevos-enlaces))))

(defun funcion-and (patrones entrada enlaces)
"Tiene exito si todos los patrones coinciden con la entrada"
(cond ((eq enlaces falla) falla)
((null patrones) enlaces)
(t (funcion-and (rest patrones)
entrada
(patron-coincide (first patrones) entrada
enlaces)))))

(defun funcion-not (patrones entrada enlaces)
"Tiene exito si ninguno de los patrones coinciden con la entrada
nunca enlazara variables."
(if (funcion-or patrones entrada enlaces)
falla
enlaces))

Ahora las funciones de coincidencia de segmento-patron. Segmento-coincide es similar a la version presentada como parte de ELIZA. La diferencia esta en como determinamos pos, la posicion del primer elemento de la entrada que podria coincidir con el siguiente elemento del patron despues de la variable de segmento. En eliza hemos asumido que la variable de segmento fue tanto el ultimo elemento del patron como lo fue el seguido por una constante. En la siguiente version, permitimos patrones no constantes para las variables de segmento. La funcion primera-pos es agregada para manejar esto. Si el siguiente elemento es de hecho una constante, el mismo calculo es hecho usando "position". Si este no es una constante, entonces solo devolvemos la primera posicion posible del inicio. A menos que deba ponerlo antes al final de la entrada, en cuyo caso devolvemos nil para indicar falla:

(defun segmento (patron entrada enlaces &optional (inicio 0))
"Coincide el patron de segmento ((?* var) . pat) con la entrada"
(let ((var (second (first patron)))
(pat (rest patron)))
(if (null pat)
(coincidir-variable var entrada enlaces)
(let ((pos (primera-pos (first pat) entrada inicio)))
(if (null pos)
falla
(let ((b2 (patron-coincide
pat (subseq entrada pos)
(coincidir-variable var (subseq entrada 0 pos)
enlaces))))
;;si esta coincidencia falla, intenta otra mas larga
(if (eq b2 falla)
(segmento patron entrada enlaces (+ pos 1))
b2)))))))

(defun primera-pos (pat1 entrada inicio)
"Busca la primera posicion con que pat1 posiblemente coincidiria con la entrada,
comenzando en la posicion inicio. Si pat1 es no-constante entonces
solo devuelve inicio."
(cond ((and (atom pat1) (not (variable-p pat1)))
(position pat1 entrada :start inicio :test #'equal))
((< inicio (length entrada)) inicio)
(t nil)))

En el primer ejemplo abajo, la variable de segmento ?x coincide con la secuencia (b c). En el segundo ejemplo hay dos variables de segmento en una columna. La primera coincidencia exitosa es lograda con la primer variable, ?x, coincide con la secuencia vacía, y la segunda, ?y, coincide con (b c).

> (patron-coincide '(a (?* ?x) d) '(a b c d))
((?x B C ))

> (patron-coincide '(a (?* ?x) (?* ?y) d) '(a b c d))
((?Y B C) (?X))

En el siguiente ejemplo, ?x coincide con nil y ?y coincide con (b c d), pero falla, de esta manera intentamos hacer coincidir ?x con un segmento de longitud uno. Que falla tambien, pero finalmente la coincidencia es exitosa, con ?x coincidiendo con un segmento de dos elementos (b c) y ?y coincidiendo con (d).

> (patron-coincide '(a (?* ?x) (?* ?y) ?x ?y) '(a b c d (b c) (d)))
((?Y ?D) (?X B C))

Dada la coincidencia de segmentos, es facil definir las funciones para coincidir uno o mas elementos y la funcion para coincidir cero o un elemento:

(defun segmento+ (patron entrada enlaces)
"Coincide con uno o mas elementos de la entrada"
(segmento patron entrada enlaces 1))

(defun segmento? (patron entrada enlaces)
"Coincide con cero o un elemento de la entrada"
(let ((var (second (first patron)))
(pat (rest patron)))
(or (patron-coincide (cons var pat) entrada enlaces)
(patron-coincide pat entrada enlaces))))

Finalmente, abasteceremos la funcion para probar una pieza arbitraria de codigo Lisp. Ella hace esto mediante la evaluacion del codigo con los enlaces implicados en la lista de enlaces. Este es uno de los pocos casos donde es apropiado llamar a eval: cuando queremos dar al usuario acceso irrestricto al interprete Lisp.

(defun funcion-if (patron entrada enlaces)
"Prueba una expresion arbitraria envolviendo variables.
El patron luce como ((?if codigo) . rest)"
(and (progv (mapcar #'car enlaces)
(mapcar #'cdr enlaces)
(eval (second (first patron))))
(patron-coincide (rest patron) entrada enlaces)))