newlispfanclub.alh.net

Code: Select all

;
; Two words are friends if they have a Levenshtein distance of 1.
; That is, you can add, remove, or substitute exactly one letter in 
; word X to create word Y.
; A words social network consists of all of its friends, plus all of 
; their friends, and all of their friends friends, and so on. 
; 
; Write a program to tell us how big the
; social network for the word causes is, using this word list:
; https://github.com/causes/puzzles/raw/master/word_friends/word.list
;
; http://en.wikipedia.org/wiki/Levenshtein_distance
;
; tons of implementations in several languages
; http://en.wikibooks.org/wiki/Algorithm_Implementation/Strings/Levenshtein_distance
;
; a working HTML version
; http://www.miislita.com/searchito/levenshtein-edit-distance.html
;

Code: Select all

(define (get-friends word word-list)
  (let ((new-words '())
        (alphabet (explode "abcdefghijklmnopqrstuvwxyz"))
        (tmpWord ""))

    ;; Deletes (removing one letter)
    (for (i 0 (- (length word) 1))
      (setf tmpWord word)
      (pop tmpWord i)
      (push tmpWord new-words -1)) 

    ;; Modifies (one letter to another)
    (for (i 0 (- (length word) 1))
      (set 'tmpWord word)
      (dolist (a alphabet)
        (when (not (= (word i) a))
          (setf (tmpWord i) a)
          (push tmpWord new-words -1))))

    ;; Inserts (add a letter)
    (for (i 0 (length word))
      (dolist (a alphabet)
        (set 'tmpWord word)
        (push (push a tmpWord i) new-words -1)))

    (intersect new-words word-list)))

Code: Select all

    ;; Swaps (swap adjacent letters)
    (for (i 0 (- (length word) 2))
      (set 'tmpWord word)
      (push (push (pop tmpWord i) tmpWord (+ 1 i)) new-words -1))