Programación Preventiva

En varios textos sobre Lisp había visto frases como “Algunos lenguajes de programación son mejores para Top-Down (Primero hacer lo más grande, y después rellenar); otros, para Bottom-Up (Primero hacer todas las funciones, y depués aplicarlas); Al programar en Lisp se suele hacer de las dos formas en un programa.”, que no había entendido.

En reddit vi un link a un programita interesante, uno que arma escaleras de palabras. Por ejemplo:

1. Pasta
2. Pasto
3. Parto
4. Harto

En cada paso cambia una sola letra. Vi como lo manejaba el que lo hizo, y en algunas partes me pareció excesivamente complejo; entonces me puse a pensar en mi propia versión del programa:

Lo primero que me dí cuenta es que es algo naturalmente recursivo: el caso base es que las dos palabras sean iguales; en caso contrario, busco todas las palabras a una letra de distancia, y les aplico la función. Hay un pequeño problema con esto, pero ya lo solucionaremos. Veamos como queda eso en Lisp:

(defun escalera (inicio fin diccionario)
  (if (string-equal inicio fin) (list inicio)
    (shortest (for palabra in (vecinos palabra diccionario)
                   collect (append (list inicio) (escalera palabra fin))))))

La macro for, bastante odiada por algunos programadores funcionales, me arma una lista de todas las sub-escaleras; aunque la única que me interesa es la más corta.

Los más audaces ya habrán notado que hay algunas cosas que no están definidas; las funciones shortest y vecinos, por un lado.

La explicación completa de shortest me ocuparía todo un post, así que lo dejo para después, convengamos en que me devuelve la lista más corta de una lista de listas, y queda así:

(defun shortest (lista)
   (cond ((null (cdr lista)) (car lista))
     ((> (length (car lista)) (length (cadr lista))) (shortest (cdr lista)))
     ('t (shortest (append (list (car lista)) (cddr lista))))))

Vecinos me devuelve la lista de todas las palabras que estén a un paso de distancia (Ojo, no la distancia de Levenshtein formalmente, porque no me interesa agregar o borrar letras):

(defun vecinos (palabra diccionario)
  (loop for item in diccionario
        when (and (= (length palabra) (length item)) (un-paso-p palabra item))
        collect item))

Ahora falta un-paso-p (la p es de “predicado”, y son funciones que devuelven valores booleanos).

(defun un-paso-p (de a)
  (= (loop for ff across de
           for tt across a
           count (char-not-equal ff tt))
     1))

Ahora sí; todas las partes que necesitamos están definidas… pero si probamos el código ahora entramos en un bucle infinito: pasto es vecino de parto, y esa propiedad es reflexiva. Esto se soluciona fácilmente eliminando la primera palabra del diccionario. La nueva versión de escalera:

(defun escalera (inicio fin diccionario)
  (let ((dicc (remove inicio diccionario :test #'string-equal)))
    (if (string-equal inicio fin) (list inicio)
      (shortest (loop for palabra in (vecinos inicio diccionario)
                      collect (append (list inicio) (escalera palabra fin dicc)))))))

El problema con esto es que, cuando llega a un callejón sin salida (no hay ningún vecino de la primera palabra en el diccionario actual, retorna una lista vacía, que se agrega a la lista, y shortest se encarga de devolverme la lista más corta. Se soluciona fácilmente obligando al bucle a solo poner un valor en la lista cuando éste no sea una lista vacía… y eso sólo pasa cuando llego al final.

(defun escalera (inicio fin diccionario)
  (let ((dicc (remove inicio diccionario :test #'string-equal)))
    (if (string-equal inicio fin) (list inicio)
      (shortest (loop for palabra in (vecinos inicio diccionario)
                      for list = (escalera palabra fin dicc)
                      when (not (null list))
                      collect (append (list inicio) list))))))

Con toda honestidad, no sé si éste código funciona (aunque estoy bastante seguro) porque ya lo modifiqué y lo volví a poner acá de memoria.

El final, con un par de funciones auxiliares para optimizarlo, lo posteo después.

Después de haber terminado este programa, entendí un poco más la frase; algunas partes del programa salen naturalmente (aunque después las modifique), y usan funciones que todavía no están definidas (aunque puedo imaginar cómo funcionan) y luego implementaré; mientras otras partes surgen de analizar el programa y corregir cosas “feas”.

Programar nunca deja de sorprenderme.

Edit:Gracias a un cambio que hice en la plantilla, ahora si tengo indentación y se ve más lindo.

La última versión, incluyendo una función para cargar un diccionario y una para sólo usar las de la longitud correcta, queda así:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

(defun escalera (inicio fin diccionario)
  (escalera-aux inicio fin (recortar (length inicio) diccionario)))
 
(defun escalera-aux (inicio fin diccionario)
  (let ((dicc (remove inicio diccionario :test #'string-equal)))
    (if (string-equal inicio fin) (list inicio)
      (shortest (loop for palabra in (vecinos inicio diccionario)
                      for list = (escalera-aux palabra fin dicc)
                      do (setf dicc (remove palabra dicc :test #'string-equal))
                      when (not (null list))
                      collect (append (list inicio) list))))))
 
(defun shortest (list)
  (car (sort list (lambda (x y) (< (length x) (length y))))))
 
(defun vecinos (palabra diccionario)
  (remove-if-not (lambda (x) (un-paso-p palabra x)) diccionario))
 
(defun un-paso-p (de a)
  (= 1 (loop for ff across de
             for tt across a
             count (char-not-equal ff tt))))
 
(defun recortar (longitud diccionario)
  (remove-if-not (lambda (x) (= longitud (length x))) diccionario))
 
(defun leer-diccionario (&optional (path *diccionario-default*))
  (with-open-file (s path)
    (loop for word = (read-line s nil)
          while word
          collect word)))