levenshtein-allison.clj

levenshtein-allison.clj

;;; implementation in clojure of the levenshtein allison algorithm as defined here:
;;; http://www.csse.monash.edu.au/~lloyd/tildeFP/Haskell/1998/Edit01/

(defn min3 [w nw n]
  (if (< w nw) w (min nw n)))

(defn generate-diagonale [a b nw fn-diag-above fn-diag-below start]
  (if start
    (lazy-cat (list nw) (generate-diagonale a b nw fn-diag-above fn-diag-below false))
    (if (or (empty? a) (empty? b)) '()
	(let [a0 (first a) as (rest a)
	      b0 (first b) bs (rest b)
	      n (first (fn-diag-above))
	      w (first (fn-diag-below))
	      me (if (= a0 b0) nw (+ 1 (min3 w nw n)))]
	  (lazy-cat (list me) (generate-diagonale as bs me (fn [] (rest (fn-diag-above))) (fn [] (rest (fn-diag-below))) false))))))

(declare uppers lowers main-diag)

(defn generate-uppers [i a b fn-diag-below fn-uppers]
  (let [result (generate-diagonale a b i (fn [] (first (fn-uppers))) (fn [] (rest (fn-diag-below))) true)]
    (lazy-cat
     (list result)
     (generate-uppers (+ i 1) (rest a) b (fn [] result) (fn [] (rest uppers))))))

(defn generate-lowers [i a b fn-diag-above fn-lowers]
  (let [result (generate-diagonale a b i (fn [] (rest (fn-diag-above))) (fn [] (first (fn-lowers))) true)]
    (lazy-cat
     (list result)
     (generate-lowers (+ i 1) a (rest b) (fn [] result) (fn [] (rest lowers))))))

(defn levenshtein-allison [a b]
  (binding [uppers (lazy-cat [] (generate-uppers 1 (rest a) b (fn [] main-diag) (fn [] (rest uppers))))
	    lowers (lazy-cat [] (generate-lowers 1 a (rest b) (fn [] main-diag) (fn [] (rest lowers))))
	    main-diag (lazy-cat [] (generate-diagonale a b 0 (fn [] (first uppers)) (fn [] (first lowers)) true))]
    (let [lab (- (count a) (count b))]
      (last (cond
	     (= lab 0) main-diag
	     (> lab 0) (nth lowers lab)
	     :else (nth uppers (- lab)))))))
;;;(levenshtein-allison "kitten" "sitting")
;;;(levenshtein-allison "acgtacgtacgt" "acatacttgtact")