Inteligencia Artificial 1: Los primeros programas con ia. (C: SGP versión 2. Otros dominios de problemas)

Nota del T: Antes de comenzar debemos crear una función: mappend. mappend es una función de orden superior construida en el desarrollo de este libro, y que se usará regularmente, tal como encontrar-todos-if. Toma dos argumentos, una función y una lista. Mappend aplica la función sobre cada elemento de la lista y une juntos todos los resultados. La primera definición sigue inmediatamente de la descripción y el hecho de que la función apply puede ser usada para aplicar una función a una lista de argumentos.

(defun mappend (funcion lista)

  "Aplica funcion a cada elemento de la lista y une los resultados."

  (apply #'append (mapcar funcion lista)))

Ahora experimentamos un poco para ver cómo trabaja mappend. El primer ejemplo aplica la funcion + a una lista de números:

> (apply #'+ '(1 2 3 4)) => 10

El próximo ejemplo aplica append a una lista de dos argumentos, donde cada argumento es una lista. Si los argumentos no son listas, daría error.

> (apply #'append '((1 2 3) (a b c))) => (1 2 3 A B C)

Ahora definimos una nueva funcion, mismo-y-doble, y aplicamos una variedad de argumentos.

> (defun mismo-y-doble (x) (list x (+ x x)))

> (mismo-y-doble 3) => (3 6)

> (apply #'mismo-y-doble '(3)) => (3 6)

Si hemos intentado aplicar mismo-y-doble a una lista de más que un argumento, o a una lista que no contiene un número, daría un error al evaluar (mismo-y-doble 3 4) o (mismo-y-doble 'Pedro). Ahora debemos regresar a las funciones de mapeo:

> (mapcar #'mismo-y-doble '(1 10 300)) => ((1 2) (10 20) (300 600))

> (mappend #'mismo-y-doble '(1 10 300)) => (1 2 10 20 300 600)

Cuando se pasa a mapcar una función y una lista de tres argumentos, ésta siempre devuelve una lista de tres valores. Cada valor es el resultado de llamar la función sobre el argumento respectivo. En contraste, cuando mappend es llamado, devuelve una lista grande, que es igual a todos los valores que mapcar podría generar uniendo todo. Daría un error la llamada a mappend sin una función que no devuelva listas, debido a que append espera listas como sus argumentos.

Nota del T: deberás cargar gps1.lisp y gps2.lisp para ejecutar los ejemplos, o ir construyéndolos a medida que avanza. Estos ejemplos los podes bajar de dominios.lisp.

El dominio de Búsqueda del Laberinto

Ahora consideraremos otro problema "clásico", búsqueda del laberinto. Asumiremos un laberinto particular, diagramado aquí:

 

Es mucho más fácil definir algunas funciones para ayudar a construir los operadores para este dominio que podrían escribir en todos los operadores directamente. El siguiente código define un conjunto de operadores para laberintos en general, y para este laberinto en particular:

(defun construir-laberinto-ops (par)

  "Construye ops laberinto en ambas direcciones"

  (list (construir-laberinto-op (first par) (second par))

                (construir-laberinto-op (second par) (first par))))

(defun construir-laberinto-op (aqui alla)

  "Construye un operador para mover entre dos lugares"

  (op `(mover desde ,aqui hacia ,alla)

      :precondiciones `((en ,aqui))

      :agregar-lista `((en ,alla))

      :borrar-lista `((en ,aqui))))

Nota del T: Observe la comilla (`) es casi lo mismo que la comilla ('), solo que después de cada coma (,) dentro del paréntesis, se activa la evaluación. En este caso se devuelve el valor que tiene "aqui" o "alla".

(defun mappend (funcion lista)

  "Aplica funcion a cada elemento de la lista y une los resultados."

  (apply #'append (mapcar funcion lista)))

(defparameter *ops-laberinto*

  (mappend #'construir-laberinto-ops

                   '((1 2) (2 3) (3 4) (4 9) (9 14) (9 8) (8 7) (7 12) (12 13)

                     (12 11) (11 6) (11 16) (16 17) (17 22) (21 22) (22 23)

                     (23 18) (23 24) (24 19) (19 20) (20 15) (15 10) (10 5) (20 25))))

Podemos ahora usar esta lista de operadores para resolver varios problemas con este laberinto. Y fácilmente podríamos crear otros laberintos dando otra lista de conexiones. Observe que no hay nada que diga que los lugares en el laberinto están dispuestos en un tablero de 5x5, esto es solo una manera de visualizar la conectividad.

> (use *ops-laberinto*) => 48

>  (sgp '((en 1)) '((en 25)))

((INICIO) (EJECUTANDO (MOVER DESDE 1 HACIA 2))

 (EJECUTANDO (MOVER DESDE 2 HACIA 3)) (EJECUTANDO (MOVER DESDE 3 HACIA 4))

 (EJECUTANDO (MOVER DESDE 4 HACIA 9)) (EJECUTANDO (MOVER DESDE 9 HACIA 8))

 (EJECUTANDO (MOVER DESDE 8 HACIA 7)) (EJECUTANDO (MOVER DESDE 7 HACIA 12))

 (EJECUTANDO (MOVER DESDE 12 HACIA 11)) (EJECUTANDO (MOVER DESDE 11 HACIA 16))

 (EJECUTANDO (MOVER DESDE 16 HACIA 17)) (EJECUTANDO (MOVER DESDE 17 HACIA 22))

 (EJECUTANDO (MOVER DESDE 22 HACIA 23)) (EJECUTANDO (MOVER DESDE 23 HACIA 24))

 (EJECUTANDO (MOVER DESDE 24 HACIA 19)) (EJECUTANDO (MOVER DESDE 19 HACIA 20))

 (EJECUTANDO (MOVER DESDE 20 HACIA 25)) (EN 25))

Hay un bug sutil que el dominio de laberintos deja afuera. Buscamos que el SGP devuelva una lista de las acciones ejecutadas. Sin embargo, para el caso donde los objetivos pueden ser alcanzados sin ninguna acción, yo incluí (INICIO) en el valor devuelto por SGP. Estos ejemplos incluyen las formas INICIO y EJECUTANDO pero también una lista de formas (EN n), para algunos n. Este es el bug. Si volvemos para atrás y miramos en la funcion SGP, encontramos que este reporta el resultado de remover todos los átomos desde el estado devuelto por alcanzar-todos-los-objetivos. Este es un "juego de palabras" -decimos remueve átomos, cuando lo que realmente queremos es remover todas las condiciones excepto las formas (INICIO) y (EJECUTANDO accion). Bien por ahora, todas estas condiciones eran átomos, esto es un acercamiento. El dominio de laberintos introduce condiciones de la forma (EN n), así que para la primera vez hubo un problema. La moraleja es que cuando un programador usa juegos de palabras convenientes en lugar de lo que realmente pasa hay un problema. Lo que realmente buscamos no es remover átomos sino encontrar todos los elementos que denotan acciones. El código abajo dice lo que queremos:

(defun SGP (estado objetivos &optional (*ops* *ops*))

  "Solución General de Problemas: desde estado, alcanza objetivos usando *ops*."

  (encontrar-todos-if #'accion-p

                       (alcanzar-todos-los-objetivos (cons '(inicio) estado) objetivos nil)))

(defun accion-p (x)

  "Es x algo que sea (inicio) o (ejecutando ...)?"

  (or (equal x '(inicio)) (ejecutando-p x)))

El dominio de laberintos resuelve también puntos afuera una ventaja de la versión 2: que devuelve una representación de las acciones tomadas mejor que solo imprimirlas en pantalla. La razón de esto es un ventaja es que podemos buscar usar los resultados para algo, es mejor que solo mirarlos. Suponga que buscamos una funcion que nos dé un camino a través de un laberinto como una lista de ubicaciones para visitar en turnos. Podríamos hacer esto llamando a SGP como una subfuncion y luego manipular los resultados:

(defun encontrar-camino (inicio fin)

  "Busca un laberinto por un camino desde inicio hasta fin."

  (let ((resultados (SGP `((en ,inicio)) `((en ,fin)))))

    (unless (null resultados)

      (cons inicio (mapcar #'destino

                                                  (remove '(inicio) resultados

                                                                  :test #'equal))))))

(defun destino (accion)

  "Encuentra el Y en (ejecutando (mover desde X hacia Y))"

  (fifth (second accion))) (fifth lista) ;fifth devuelve el quinto elemento de lista

La función encontrar-camino llama a SGP para obtener los resultados. Si este el nil, no hay respuesta, luego toma el resto de los resultados (en otras palabras, ignora la parte (inicio)). Escoge el destino, y, de cada forma (EJECUTANDO (MOVER DESDE x HACIA y)), y recuerda incluir el punto de inicio.

> (use *ops-laberinto*) => 48

> (encontrar-camino 1 25) =>

(1 2 3 4 9 8 7 12 11 16 17 22 23 24 19 20 25)

> (encontrar-camino 1 1) => (1)

> (equal (encontrar-camino 1 25) (reverse (encontrar-camino 25 1))) => T

El dominio del Mundo de Bloques

Otro dominio que ha llamado la atención en círculos de inteligencia artificial es el dominio del mundo de bloques. Imagine un conjunto de bloques de construcción para niños sobre una mesa. El problema es mover los bloques desde su configuración inicial en algunas configuraciones objetivo. Asumiremos que cada bloque puede tener solamente otro bloque directamente sobre el, aunque ellos pueden ser apilados en alturas arbitrarias. La única acción que puede tomar en este mundo es mover un solo bloque que no tenga nada encima de él, tanto por encima de otro bloque como sobre la mesa que representa el mundo de bloques. Crearemos un operador para cada posible movimiento de bloques.

(defun construir-bloques-ops (bloques)

  (let ((ops nil))

    (dolist (a bloques)

      (dolist (b bloques)

                (unless (equal a b)

                  (dolist (c bloques)

                    (unless (or (equal c a) (equal c b))

                      (push (mover-op a b c) ops)))

                  (push (mover-op a 'mesa b) ops)

                  (push (mover-op a b 'mesa) ops))))

    ops))

(defun mover-op (a b c)

  "Construir un operador para mover A desde B hacia C"

  (op `(mover ,a desde ,b hacia ,c)

      :precondiciones `((espacio sobre ,a) (espacio sobre ,c) (,a sobre ,b))

      :agregar-lista (mover-sobre a b c)

      :borrar-lista (mover-sobre a c b)))

(defun mover-sobre (a b c)

(if (eq b 'mesa)

    `((,a sobre ,c))

  `((,a sobre ,c) (espacio sobre ,b))))

Ahora intentaremos estos operadores sobre algunos problemas. El problema más simple posible es apilar un bloque sobre otro:

> (use (construir-bloques-ops '(a b))) => 4

> (sgp '((a sobre mesa) (b sobre mesa) (espacio sobre a) (espacio sobre b)

                 (espacio sobre mesa))

       '((a sobre b) (b sobre mesa)))

((INICIO) (EJECUTANDO (MOVER A DESDE MESA HACIA B)))

Hay un problema ligeramente más complejo: invertir una pila de dos bloques. Esta vez mostraremos la salida de-bug.

> (de-bug :sgp) => (:SGP)

> (sgp '((a sobre b) (b sobre mesa) (espacio sobre a) (espacio sobre mesa))

       '((b sobre a)))

Objetivo: (B SOBRE A)

Considera: (MOVER B DESDE MESA HACIA A)

 Objetivo: (ESPACIO SOBRE B)

 Considera: (MOVER A DESDE B HACIA MESA)

  Objetivo: (ESPACIO SOBRE A)

  Objetivo: (ESPACIO SOBRE MESA)

  Objetivo: (A SOBRE B)

 Accion: (MOVER A DESDE B HACIA MESA)

 Objetivo: (ESPACIO SOBRE A)

 Objetivo: (B SOBRE MESA)

Accion: (MOVER B DESDE MESA HACIA A)

((INICIO) (EJECUTANDO (MOVER A DESDE B HACIA MESA))

 (EJECUTANDO (MOVER B DESDE MESA HACIA A)))

> (undebug) => NIL

Nota del T: deberás cargar gps1.lisp, gps2.lisp y dominios.lisp para ejecutar los siguientes ejemplos, o ir construyéndolos a medida que avanzas. Los siguientes ejemplos están en dominios2.lisp. Hago así porque van cambiando algunas funciones en los ejemplos que siguen.

Algunas veces es importante que intentes resolver los conjuntos adentro. Por ejemplo, no puedes tener tu pastel y haberlo comido al mismo tiempo, pero puedes tener una fotografía de tu pastel y haberlo comido al mismo tiempo, como veras tomas la fotografía antes de comértelo. En el mundo de bloques, tenemos:

                                                                  

(use (construir-bloques-ops '(a b c))) => 18

> (sgp '((a sobre b) (b sobre c) (c sobre mesa) (espacio sobre a) (espacio sobre mesa))

       '((b sobre a) (c sobre b)))

((INICIO) (EJECUTANDO (MOVER A DESDE B HACIA MESA))

 (EJECUTANDO (MOVER B DESDE C HACIA A))

 (EJECUTANDO (MOVER C DESDE MESA HACIA B)))

> (sgp '((a sobre b) (b sobre c) (c sobre mesa) (espacio sobre a) (espacio sobre mesa))

       '((c sobre b) (b sobre a)))

NIL

En el primer caso, la torre fue construida poniendo B sobre A primero, y luego C sobre B. En el segundo caso, el programa primero toma C sobre B, pero incluía ese objetivo mientras tomaba B sobre A. La situación de "objetivo hermano incluido" es reconocida, pero el programa no hace nada con eso. Una cosa que podría hacer es intentar variar el orden del conjunto de objetivos. Esto es, podríamos cambiar alcanzar-todos-los-objetivos como sigue:

(defun alcanzar-todos-los-objetivos (estado objetivos pila-objetivo)

  "Alcanza cada objetivo, intentando algunos ordenamientos."

  (some #'(lambda (objetivos) (alcanza-cada-uno estado objetivos pila-objetivo))

                             (ordenamientos objetivos)))

(defun alcanza-cada-uno (estado objetivos pila-objetivo)

  "Alcanza cada objetivo, y se asegura que ellos se cumplan al final."

  (let ((estado-actual estado))

    (if (and (every #'(lambda (g)

                                               (setf estado-actual

                                                     (alcanzar-objetivo estado-actual g pila-objetivo)))

                                   objetivos)           

                                  (subsetp objetivos estado-actual :test #'equal))

                             estado-actual)))

(defun ordenamientos (l)

  (if (> (length l) 1)

      (list l (reverse l))

    (list l)))

Ahora podemos representar el objetivo de cada manera, y se cumplirán tomando una respuesta. Observe que únicamente consideramos dos ordenamientos. El orden dado y el orden al revés. Obviamente, para conjuntos de objetivos de uno dos conjuntos se usan todas las posibilidades de ordenamiento. En general, si hay solo una interacción por conjunto de objetivos, luego uno de estos dos ordenamientos funcionará. De esta manera, asumimos que las interacciones del tipo "objetivo hermano incluido" son raras, y que raramente ocurrirá más de una interacción por conjunto de objetivos. Otra posibilidad seria considerar todas las posibles permutaciones de los objetivos, pero eso podría tomar un largo tiempo con conjuntos de objetivos extensos. Otra consideración es la eficiencia de soluciones. Considera la simple tarea de tomar el bloque C sobre la mesa en el siguiente diagrama:

> (sgp '((c sobre a) (a sobre mesa) (b sobre mesa)

                              (espacio sobre c) (espacio sobre b) (espacio sobre mesa))

       '((c sobre mesa)))

((INICIO) (EJECUTANDO (MOVER C DESDE A HACIA B))

 (EJECUTANDO (MOVER C DESDE B HACIA MESA)))

La solución es correcta, pero hay una solución más fácil que mueve C directamente a la mesa. La solución más simple no fue encontrada debido a un accidente: sucedió que construir-bloques-ops define los operadores de manera tal que  mover C desde B hacia la mesa ocurre antes de mover C desde A a la mesa. De esta manera el primer operador es intentado, y eso es exitoso estableciendo que C esta sobre B. De este modo, la solución de dos pasos es encontrada antes siquiera que la solución de un solo paso sea considerada. El siguiente ejemplo toma cuatro pasos cuando podría hacerse en dos:

                                                               

> (sgp '((c sobre a) (a sobre mesa) (b sobre mesa)

                              (espacio sobre c) (espacio sobre b) (espacio sobre mesa))

       '((c sobre mesa) (a sobre b)))

((INICIO) (EJECUTANDO (MOVER C DESDE A HACIA B))

 (EJECUTANDO (MOVER C DESDE B HACIA MESA))

 (EJECUTANDO (MOVER A DESDE MESA HACIA C))

 (EJECUTANDO (MOVER A DESDE C HACIA B)))

¿Cómo podríamos encontrar soluciones más cortas? Una manera podría ser hacer una búsqueda completa: las soluciones cortas se intentan primero, temporalmente abandonadas cuando algo sea más prometedor, y luego reconsideradas más tarde. Este enfoque es tomado en el capítulo 6, usando una función de búsqueda general. Una solución menos drástica es hacer un reordenamiento del orden en que los operadores son buscados: lo que tienen menos precondiciones se intentan primero. En particular, esto significa que los operadores con todas las precondiciones previas cumplidas siempre se intentan antes que los otros operadores. Para implementar este enfoque, cambiamos alcanzar-objetivo:

(defun alcanzar-objetivo (estado objetivo pila-objetivo)

  "Un objetivo se logra si ya se cumple, o si hay una opción apropiada para el que sea aplicable."

 

  (dbg-indent :sgp (length pila-objetivo) "Objetivo: ~a" objetivo)

 

  (cond ((member-equal objetivo estado) estado)

                             ((member-equal objetivo pila-objetivo) nil)

                             (t (some #'(lambda (op) (aplicar-op estado objetivo op pila-objetivo))

                                (apropiado-ops objetivo estado))))) ))))

(defun apropiado-ops (objetivo estado)

  "Devuelve una lista de operadores apropiados, ordenados segun el numero de precondiciones insatisfechas."

  (sort (copy-list (encontrar-todos objetivo *ops* :test #'apropiado-p)) #'<

                             :key #'(lambda (op)

                                (count-if #'(lambda (precondiciones)

                                                      (not (member-equal precondiciones estado)))

                                                  (op-precondiciones op)))))

Ahora obtenemos las soluciones que buscamos:

> (sgp '((c sobre a) (a sobre mesa) (b sobre mesa)

                              (espacio sobre c) (espacio sobre b) (espacio sobre mesa))

                                                                                     '((c sobre mesa) (a sobre b)))

((INICIO) (EJECUTANDO (MOVER C DESDE A HACIA MESA))

 (EJECUTANDO (MOVER A DESDE MESA HACIA B)))

> (sgp '((a sobre b) (b sobre c) (c sobre mesa) (espacio sobre a) (espacio sobre mesa))

       '((b sobre a) (c sobre b)))

((INICIO) (EJECUTANDO (MOVER A DESDE B HACIA MESA))

 (EJECUTANDO (MOVER B DESDE C HACIA A))

 (EJECUTANDO (MOVER C DESDE MESA HACIA B)))

>(sgp '((a sobre b) (b sobre c) (c sobre mesa) (espacio sobre a) (espacio sobre mesa))

      '((c sobre b) (b sobre a)))

((INICIO) (EJECUTANDO (MOVER A DESDE B HACIA MESA))

 (EJECUTANDO (MOVER B DESDE C HACIA A))

 (EJECUTANDO (MOVER C DESDE MESA HACIA B)))      

La anomalía Sussman

Sorprendentemente, hay problemas que no pueden ser resueltos por ningún reordenamiento de objetivos. Considere:

Esto no luce muy difícil, así que veamos cómo lo maneja nuestro SGP:

> (setf comienza '((c sobre a) (a sobre mesa) (b sobre mesa) (espacio sobre c)

                                  (espacio sobre b) (espacio sobre mesa)))

((C SOBRE A) (A SOBRE MESA) (B SOBRE MESA) (ESPACIO SOBRE C) (ESPACIO SOBRE B)

 (ESPACIO SOBRE MESA))

> (sgp comienza '((a sobre b) (b sobre c)))

NIL

> (sgp comienza '((b sobre c) (a sobre b)))

NIL

Hay un problema de "objetivo hermano incluido" ¡sin importar cuál sea el orden de los conjuntos! En otras palabras, ninguna combinación de planes para los dos objetivos individuales puede resolver la conjunción de los dos objetivos. Esto es sorprendentemente cierto, y el ejemplo ha sido conocido como "la anomalía Sussman". Volveremos a este problema en el capítulo 6.

Dejo los enlaces del sgp y los ejemplos mostrados aquí: gps1.lisp, gps2.lisp, dominios.lisp y dominios2.lisp.