toplevel-levenshtein-cps-memoize.clj

toplevel-levenshtein-cps-memoize.clj

(defn min-cps [args ret]
  (ret (apply min args)))
(defn plus-cps [args ret]
  (ret (apply + args)))
(defn multiply-cps [args ret]
  (ret (apply * args)))
(defn equals-cps [a b ret]
  (ret (= a b)))

(defn toplevel-levenshtein-cps-memoize [x y]
  (let [mem (atom {})]
    (letfn [(levenshtein-cps-memoize-rec
	     [x y ret]
	     (if-let [e (find @mem (list x y))]
	       #(ret (val e))
	       (cond
		(empty? x) #(ret (count y))
		(empty? y) #(ret (count x))
		:default
		#(levenshtein-cps-memoize-rec
		  (rest x) (rest y)
		  (fn [levenstein-change]
		    (do 
		      (swap! mem assoc (list (rest x) (rest y)) levenstein-change)
		      (plus-cps
		       (list levenstein-change (toplevel-change-cost (first x) (first y)))
		       (fn [last-addend]
			 (levenshtein-cps-memoize-rec
			  x (rest y)
			  (fn [levenstein-addition]
			    (do
			      (swap! mem assoc (list x (rest y)) levenstein-addition)
			      (plus-cps
			       (list levenstein-addition 1)
			       (fn [middle-addend]
				 (levenshtein-cps-memoize-rec
				  (rest x) y
				  (fn [levenstein-deletion]
				    (do 
				      (swap! mem assoc (list (rest x) y) levenstein-deletion)
				      (plus-cps
				       (list levenstein-deletion 1)
				       (fn [first-addend]
					 (min-cps (list first-addend middle-addend last-addend) ret)))))))))))))))))))]
      (trampoline levenshtein-cps-memoize-rec x y identity))))