tweaking cost function

1 files changed, 12 insertions, 35 deletions

diff --git a/zhsh.lisp b/zhsh.lisp
index d68f349..945785e 100644
--- a/zhsh.lisp
+++ b/zhsh.lisp
@@ -2,18 +2,6 @@
 
 (in-package #:zhsh)
 
-;; edit operations
-;; 1. change (a → b)
-;; 2. delete (a → Λ)
-;; 3. insert (Λ → b)
-
-;; need to get the ith node of a tree according to postorder numbering
-
-;; need to be able to calc the left most leaf descendent of a tree
-;; rooted at a given node, itself accessed by postorder index
-
-;; need to be able to lookup the parents of nodes, by their postorder index.
-
 (defclass postorder-tree ()
   ((data
     :accessor tree-data
@@ -76,18 +64,6 @@
 (defun tree-root (tree)
   (1- (car (array-dimensions (tree-data tree)))))
 
-;; (defun depth (tree)
-;;   (labels ((rec (node)
-;;              (1+
-;;               (cond
-;;                 ((null (children tree node))
-;;                  0)
-;;                 ((null (rest (children tree node)))
-;;                  (rec (first (children tree node))))
-;;                 (t
-;;                  (apply #'max (mapcar #'rec (children tree node))))))))
-;;     (rec (root-node tree))))
-
 (defun tree-size (tree)
   (first (array-dimensions (tree-data tree))))
 
@@ -206,14 +182,15 @@
 
 (defun cost (op)
   (case (first op)
-    (:rem 1)
-    (:add 1)
+    (:delete 1)
+    (:insert 1)
     (:change
      (destructuring-bind (_change i _in1 t1 _to j _in2 t2) op
        (declare (ignore _change _in1 _in2 _to))
-       (if (equal (node t1 i) (node t2 j))
-           0
-           1)))))
+       (cond ((equal (node t1 i) (node t2 j))
+              0)
+             (t
+              2))))))
 
 (defun treedist (t1 t2)
   (cond
@@ -245,11 +222,11 @@
                (loop for i from lk1 to k1
                      do (setf (gethash (fkey i nil) fdist)
                               (+ (forestdist (1- i) nil)
-                                 (cost (list :rem i :from t1)))))
+                                 (cost (list :delete i :from t1)))))
                (loop for j from lk2 to k2
                      do (setf (gethash (fkey nil j) fdist)
                               (+ (forestdist nil (1- j))
-                                 (cost (list :add j :to t2)))))
+                                 (cost (list :insert j :to t2)))))
                (loop for i from lk1 to k1 do
                  (loop for j from lk2 to k2 do
                    (cond
@@ -259,10 +236,10 @@
                        (gethash (fkey i j)  fdist)
                        (min
                         (+ (forestdist (1- i) j)
-                           (cost (list :rem i :from t1)))
+                           (cost (list :delete i :from t1)))
                         
                         (+ (forestdist i (1- j))
-                           (cost (list :add j :to t2)))
+                           (cost (list :insert j :to t2)))
                         
                         (+ (forestdist (1- i) (1- j))
                            (cost (list :change i :in t1
@@ -275,10 +252,10 @@
                        (gethash (fkey i j) fdist)
                        (min
                         (+ (forestdist (1- i) j)
-                           (cost (list :rem i :from t1)))
+                           (cost (list :delete i :from t1)))
 
                         (+ (forestdist i (1- j))
-                           (cost (list :add j :to t2)))
+                           (cost (list :insert j :to t2)))
                         (+ (forestdist (1- i) (1- j))
                            (gethash (list i j) treedist))))))))))))
        (gethash (list (tree-root t1) (tree-root t2))