Add CLOS to union-find

lisp-algo.asd

@@ -4,10 +4,13 @@
     :version "0.0.1"
     :depends-on ("lisp-unit")
     :perform (test-op (o s) (symbol-call :com.lisp-algo.test :do-tests))
+    :serial t
     :components ((:file "packages")
                  (:module "union-find"
+                          :serial t
                           :depends-on ("packages")
-                          :components ((:file "quick-find")
+                          :components ((:file "union-find")
+                                       (:file "quick-find")
                                        (:file "quick-union")
                                        (:file "weighted-quick-union")
                                        (:file "weighted-quick-union-path-compression")))

packages.lisp

@@ -5,31 +5,22 @@
 (defpackage :com.lisp-algo.union-find
   (:use :common-lisp)
   (:nicknames :uf)
-  ;; Quick-Find
+  (:shadow :union)
-  (:export :qf-create-network
+  (:export :union
-           :qf-union
+           :connected
-           :qf-connected)
+           :quick-find ; Class
-  ;; Quick-Union
+           :quick-union ; Class
-  (:export :qu-create-network
+           :weighted-quick-union ; Class
-           :qu-union
+           :weighted-quick-union-path-compression ; Class
-           :qu-connected)
+           :network ; Accessor
-  ;; Weighted-Quick-Union
+           :network-size ; Accessor
-  (:export :wqu-create-network
+           :quick-union))
-           :wqu-create-network
-           :wqu-union
-           :wqu-connected)
-  ;; Weighted-Quick-Union with Path Compression
-  (:export :wqupc-create-network
-         :wqupc-create-network
-         :wqupc-union
-         :wqupc-connected))
-
-
 ;;; Unit tests
 
 (defpackage :com.lisp-algo.test
   (:use :common-lisp
         :lisp-unit
         :com.lisp-algo.union-find)
-    (:export :get-row))
+  (:shadow :union)
+  (:export :get-row))
 

test/union-find.lisp

@@ -12,57 +12,45 @@
 
 
 ;;; Test create network
-(define-test create-network-test ()
+(define-test initialize-instance-test ()
-  ;; ----- Length tests
+  ;; ----- Network Length Tests
-  (dotimes (nw-size 1000)
+  (dotimes (test-size 100)
-    (assert-equal nw-size (length (qf-create-network nw-size))) ; Quick-Find
+    (let* ((algo (make-instance 'quick-find :network-size test-size)) ; Quick Find
-    (assert-equal nw-size (length (qu-create-network nw-size))) ; Quick-Union
+           (nw (network algo))
-    ;; Weighted-Quick-Union
+           (nw-size (network-size algo)))
-    (assert-equal 10 (length (get-row (wqu-create-network 10) 0)))
+      (assert-equal test-size nw-size)
-    (assert-equal 10 (length (get-row (wqu-create-network 10) 1)))
+      (assert-equal test-size (length nw)))
-    ;; Weighted-Quick-Union with Path Compression
+    (let* ((algo (make-instance 'quick-union :network-size test-size)) ; Quick Union
-    (assert-equal 10 (length (get-row (wqupc-create-network 10) 0)))
+           (nw (network algo))
-    (assert-equal 10 (length (get-row (wqupc-create-network 10) 1))))
+           (nw-size (network-size algo)))
-  ;; ----- Value tests
+      (assert-equal test-size nw-size)
-  (assert-equalp #(0 1 2 3 4) (qf-create-network 5)) ; Quick-Find
+      (assert-equal test-size (length nw)))
-  (assert-equalp #(0 1 2 3 4) (qu-create-network 5)) ; Quick-Union
+    (let* ((algo (make-instance 'weighted-quick-union :network-size test-size)) ; Weighted Quick Union
-  ;; Weighted-Quick-Union
+           (nw (network algo))
-  (assert-true (equalp #(0 1 2 3 4 5 6 7 8 9) (get-row (wqu-create-network 10) 0)))
+           (nw-size (network-size algo)))
-  (assert-true (equalp (make-array 10 :initial-element 1) (get-row (wqu-create-network 10) 1)))
+      (assert-equal test-size nw-size)
-  ;; Weighted-Quick-Union with Path Compression
+      (assert-equal test-size (length (get-row nw 0)))
-  (assert-true (equalp #(0 1 2 3 4 5 6 7 8 9) (get-row (wqupc-create-network 10) 0)))
+      (assert-equal test-size (length (get-row nw 1))))
-  (assert-true (equalp (make-array 10 :initial-element 1) (get-row (wqupc-create-network 10) 1))))
+    (let* ((algo (make-instance 'weighted-quick-union-path-compression :network-size test-size)) ; Weighted Quick Union Path Compression
-
+           (nw (network algo))
-
+           (nw-size (network-size algo)))
-;; (define-test test-union_
+      (assert-equal test-size nw-size)
-;;     (let ((nw (create-network 10)))
+      (assert-equal test-size (length (get-row nw 0)))
-;;       (setf nw (union_ nw 1 2))
+      (assert-equal test-size (length (get-row nw 1)))))
-;;       (setf nw (union_ nw 0 5))
+    ;; ----- Network Values Tests
-;;       (assert-equal (aref nw 1) (aref nw 2))
+    (let* ((algo (make-instance 'quick-find :network-size 5)) ; Quick Find
-;;       (assert-equal (aref nw 0) (aref nw 5))
+           (nw (network algo)))
-;;       (assert-false (equal (aref nw 0) (aref nw 8)))
+      (assert-true #(0 1 2 3 4) nw))
-;;       (assert-false (equal (aref nw 0) (aref nw 2)))))
+    (let* ((algo (make-instance 'quick-union :network-size 5)) ; Quick Union
-
+           (nw (network algo)))
-;; (define-test test-connected
+      (assert-true #(0 1 2 3 4) nw))
-;;     (let ((nw (create-network 10)))
+    (let* ((algo (make-instance 'weighted-quick-union :network-size 10)) ; Weighted Quick Union
-;;       (setf nw (union_ nw 1 2))
+           (nw (network algo)))
-;;       (setf nw (union_ nw 0 5))
+      (assert-true (equalp #(0 1 2 3 4 5 6 7 8 9) (get-row nw 0)))
-;;       (assert-true (connected nw 1 2))
+      (assert-true (equalp (make-array 10 :initial-element 1) (get-row nw 1))))
-;;       (assert-true (connected nw 0 5))
+    (let* ((algo (make-instance 'weighted-quick-union-path-compression :network-size 10)) ; Weighted Quick Union Path Compression
-;;       (assert-false (connected nw 0 8))
+           (nw (network algo)))
-;;       (assert-false (connected nw 0 2))))
+      (assert-true (equalp #(0 1 2 3 4 5 6 7 8 9) (get-row nw 0)))
-
+      (assert-true (equalp (make-array 10 :initial-element 1) (get-row nw 1)))))
-;; (define-test test-nunion__
-;;     (let ((nw (create-network 10)))
-;;       (nunion_ nw 1 2)
-;;       (nunion_ nw 0 5)
-;;       (assert-equal (aref nw 1) (aref nw 2))
-;;       (assert-equal (aref nw 0) (aref nw 5))
-;;       (assert-false (equal (aref nw 0) (aref nw 8)))
-;;       (assert-false (equal (aref nw 0) (aref nw 2)))))
-
-;; ;; Run all tests
-;; (setq *print-summary* t) ; Details tests locations when running tests
-;; (run-tests :all)
 
 

test/union-find/test-quick-find.lisp

@@ -1,45 +0,0 @@
-(load "../lisp-unit.lisp")
-(defpackage :test-quick-find
-  (:use :common-lisp
-        :lisp-unit))
-
-(in-package :test-quick-find)
-(load "../../src/union-find/quick-find.lisp")
-
-;;; Define tests
-(define-test test-create-network
-    (assert-equal 10 (length (create-network 10)))
-  (assert-equalp #(0 1 2 3 4) (create-network 5)))
-
-(define-test test-union_
-    (let ((nw (create-network 10)))
-      (setf nw (union_ nw 1 2))
-      (setf nw (union_ nw 0 5))
-      (assert-equal (aref nw 1) (aref nw 2))
-      (assert-equal (aref nw 0) (aref nw 5))
-      (assert-false (equal (aref nw 0) (aref nw 8)))
-      (assert-false (equal (aref nw 0) (aref nw 2)))))
-
-(define-test test-connected
-    (let ((nw (create-network 10)))
-      (setf nw (union_ nw 1 2))
-      (setf nw (union_ nw 0 5))
-      (assert-true (connected nw 1 2))
-      (assert-true (connected nw 0 5))
-      (assert-false (connected nw 0 8))
-      (assert-false (connected nw 0 2))))
-
-(define-test test-nunion__
-    (let ((nw (create-network 10)))
-      (nunion_ nw 1 2)
-      (nunion_ nw 0 5)
-      (assert-equal (aref nw 1) (aref nw 2))
-      (assert-equal (aref nw 0) (aref nw 5))
-      (assert-false (equal (aref nw 0) (aref nw 8)))
-      (assert-false (equal (aref nw 0) (aref nw 2)))))
-
-;; Run all tests
-(setq *print-summary* t) ; Details tests locations when running tests
-(run-tests :all)
-
-

union-find/quick-find.lisp

@@ -5,34 +5,35 @@
 
 (in-package :com.lisp-algo.union-find)
 
-;;; Base functions
+(defclass quick-find ()
+  ((nw-size
+    :initarg :network-size
+    :initform 10
+    :accessor network-size)
+   (nw
+    :initform nil
+    :accessor network)))
 
-(defun qf-create-network (n)
+(defmethod initialize-instance :after ((algo quick-find) &key)
-  "Build a quick-find network using a dynamic vector"
+  ;; Initialize network using dynamic vector
-  (let ((nodes (make-array n :fill-pointer 0)))
+  (let* ((nw-size (slot-value algo 'nw-size))
-    (dotimes (id n)
+        (nodes (make-array nw-size :fill-pointer 0)))
+    (dotimes (id nw-size)
       (vector-push id nodes))
-    nodes))
+    (setf (slot-value algo 'nw) nodes)))
 
-;; Link two nodes in the network
+(defmethod union ((algo-instance quick-find) n1 n2)
-(defun qf-union (network n1 n2)
+  (with-slots ((nw nw)) algo-instance
-  "Link two nodes in the quick-find network. union_ represent the union operation of the Quick Find Algorithm"
+  (let ((v-n1 (elt nw n1))
-  (let ((v-n1 (elt network n1))
+        (v-n2 (elt nw n2))
-        (v-n2 (elt network n2))
+        (new-network (copy-seq nw)))
-        (new-network (copy-seq network)))
     (dotimes (n (length new-network))
       (if (= (elt new-network n) v-n2) (setf (elt new-network n) v-n1)))
-    new-network))
+    (setf nw new-network))))
 
-;;; Macro definitions
+(defmethod connected ((algo-instance quick-find) n1 n2)
-
-(defmacro qf-connected (network n1 n2)
   " Return t if there is a path between n1 and n2, nil otherwise. connected represent the find operation of the Quick Find Algorithm"
-    `(= (elt ,network ,n1) (elt ,network ,n2)))
+  (with-slots ((nw nw)) algo-instance
-
+    (= (elt nw n1) (elt nw n2))))
-(defmacro qf-nunion (network n1 n2)
-  "A destructive version of union_"
-  `(setq ,network (union ,network ,n1 ,n2)))
-
 
 

union-find/quick-union.lisp

@@ -7,37 +7,40 @@
 
 (in-package :com.lisp-algo.union-find)
 
-;;; Base functions
+(defclass quick-union ()
+  ((nw-size
+    :initarg :network-size
+    :initform 10
+    :accessor network-size)
+   (nw
+    :initarg nil
+    :accessor network)))
 
-(defun qu-create-network (n)
+(defmethod initialize-instance :after ((algo quick-union) &key)
   "Build a quick-find network using a dynamic vector"
+  (with-slots ((n nw-size) (nw nw)) algo
   (let ((nodes (make-array n :fill-pointer 0)))
     (dotimes (id n)
       (vector-push id nodes))
-    nodes))
+    (setf nw nodes))))
 
-(defun qu-find-root (network node)
+(defun quick-union-find-root (network node)
   "Find the root of a sub-tree in the network."
   (do ((id node value)
        (value (elt network node) (elt network value)))
       ((= id value) id)))
 
-(defun qu-union (network n1 n2)
+(defmethod union ((algo quick-union) n1 n2)
   "Connect to sub-tree together. union represent the union operation on the Quick Union algorithm"
+  (with-slots ((network nw)) algo
   (let ((new-network (copy-seq network)))
-    (setf (elt new-network (qu-find-root new-network n1))
+    (setf (elt new-network (quick-union-find-root new-network n1))
-          (qu-find-root new-network n2))
+          (quick-union-find-root new-network n2))
-    new-network))
+    (setf network new-network))))
 
-
+(defmethod connected ((algo quick-union) n1 n2)
-;;; Macro definitions
-
-(defmacro qu-connected (network n1 n2)
   "Return true if n1 and n2 are connected and nil otherwise. connection represent
 the find operation on the Quick Union algorithm"
-  `(= (qu-find-root ,network ,n1) (qu-find-root ,network ,n2)))
+  (with-slots ((network nw)) algo
-
+  (= (quick-union-find-root network n1) (quick-union-find-root network n2))))
-(defmacro qu-nunion (network n1 n2)
-  "A destructive version of union_"
-  `(setf ,network (qu-union ,network ,n1 ,n2)))
 

union-find/union-find.lisp

@@ -0,0 +1,10 @@
+(in-package :com.lisp-algo.union-find)
+
+(defgeneric create-network (algo-instance n)
+  (:documentation "Create a network for the algo-instance"))
+
+(defgeneric union (algo-instance n1 n2)
+  (:documentation "Link two nodes in the quick-find network. union_ represent the union operation of the Quick Find Algorithm"))
+
+(defgeneric connected (algo-instance n1 n2)
+  (:documentation "Check is there is a path between n1 and n2"))

union-find/weighted-quick-union-path-compression.lisp

@@ -11,15 +11,28 @@
 
 (in-package :com.lisp-algo.union-find)
 
+
+(defclass weighted-quick-union-path-compression ()
+  ((nw-size
+    :initarg :network-size
+    :initform 10
+    :accessor network-size)
+   (nw
+    :initform nil
+    :accessor network)))
+
+
 ;;; Base functions
 
-(defun wqupc-create-network (n)
+(defmethod initialize-instance :after ((algo weighted-quick-union-path-compression) &key)
   "Build a quick-find network using a multi-dimensional dynamic vector:\n
 1st dimension = the network\n 2nd dimension = each subtree node quantities"
+  (with-slots ((n nw-size) (nw nw)) algo
   (let ((network (make-array `(2 ,n) :initial-element 1)))
     (dotimes (id n)
       (setf (aref network 0 id) id))
-    network))
+    (setf nw network))))
+
 
 (defun wqupc-find-root (network node)
   "Find the root of a sub-tree in the network. This is a destructive version of find-root that
@@ -29,33 +42,26 @@ include path compression"
       ((= id value) (progn (setf (aref network 0 node) id) ; Path compression
                            id))))
 
-(defun wqupc-union (network n1 n2)
+(defmethod union ((algo weighted-quick-union-path-compression) n1 n2)
   "Connect to sub-tree together. union represent the union operation on the Quick Union algorithm"
-  (let ((new-network (copy-tree network))) ; Duplicate network
+  (with-slots ((network nw)) algo
-    (let* ((n1-root (wqupc-find-root new-network n1))
+    (let ((new-network (copy-tree network))) ; Duplicate network
-          (n2-root (wqupc-find-root new-network n2))
+      (let* ((n1-root (wqupc-find-root new-network n1))
-           (n1-size (aref new-network 1 n1-root))
+             (n2-root (wqupc-find-root new-network n2))
-           (n2-size (aref new-network 1 n2-root)))
+             (n1-size (aref new-network 1 n1-root))
-      (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper)
+             (n2-size (aref new-network 1 n2-root)))
-          (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node
+        (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper)
-                 (setf (aref new-network 1 n1-root) ; Update tree larger
+            (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node
-                       (+ (aref new-network 1 n1-root) (aref new-network 1 n2-root))))
+                   (setf (aref new-network 1 n1-root) ; Update tree larger
+                         (+ (aref new-network 1 n1-root) (aref new-network 1 n2-root))))
           (progn (setf (aref new-network 0 n1-root) (aref new-network 0 n2-root)) ; Otherwise modify the first node
                  (setf (aref new-network 1 n2-root) ; Update tree larger
                        (+ (aref new-network 1 n2-root) (aref new-network 1 n1-root)))))
-      new-network)))
+        new-network))))
 
-
+(defmethod connected ((algo weighted-quick-union-path-compression) n1 n2)
-;;; Macro definitions
-
-
-(defmacro wqupc-connected (network n1 n2)
   "Return true if n1 and n2 are connected and nil otherwise. connection represent
 the find operation on the Quick Union algorithm"
-  `(= (wqupc-find-root ,network ,n1) (wqupc-find-root ,network ,n2)))
+  (with-slots ((network nw)) algo
-
+    (= (wqupc-find-root network n1) (wqupc-find-root network n2))))
-(defmacro wqupc-nunion (network n1 n2)
-  "A destructive version of the union function."
-  `(setf ,network (wqupc-union ,network ,n1 ,n2)))
-
 

union-find/weighted-quick-union.lisp

@@ -9,15 +9,24 @@
 
 (in-package :com.lisp-algo.union-find)
 
-;;; Base functions
 
-(defun wqu-create-network (n)
+(defclass weighted-quick-union ()
-  "Build a quick-find network using a multi-dimensional dynamic vector:\n
+  ((nw-size
+    :initarg :network-size
+    :initform 10
+    :accessor network-size)
+   (nw
+    :initform nil
+    :accessor network)))
+
+(defmethod initialize-instance :after ((algo weighted-quick-union) &key)
+    "Build a quick-find network using a multi-dimensional dynamic vector:\n
 1st dimension = the network\n 2nd dimension = each subtree node quantities"
+    (with-slots ((n nw-size) (nw nw)) algo
   (let ((network (make-array `(2 ,n) :initial-element 1)))
     (dotimes (id n)
       (setf (aref network 0 id) id))
-    network))
+    (setf nw network))))
 
 (defun wqu-find-root (network node)
   "Find the root of a sub-tree in the network."
@@ -25,33 +34,26 @@
        (value (aref network 0 node) (aref network 0 value)))
       ((= id value) id)))
 
-(defun wqu-union-union (network n1 n2)
+(defmethod union ((algo weighted-quick-union) n1 n2)
   "Connect to sub-tree together. union represent the union operation on the Quick Union algorithm"
-  (let ((new-network (copy-tree network))) ; Duplicate network
+  (with-slots ((network nw)) algo
-    (let* ((n1-root (wqu-find-root new-network n1))
+    (let ((new-network (copy-tree network))) ; Duplicate network
-          (n2-root (wqu-find-root new-network n2))
+      (let* ((n1-root (wqu-find-root new-network n1))
-           (n1-size (aref new-network 1 n1-root))
+             (n2-root (wqu-find-root new-network n2))
-           (n2-size (aref new-network 1 n2-root)))
+             (n1-size (aref new-network 1 n1-root))
-      (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper)
+             (n2-size (aref new-network 1 n2-root)))
-          (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node
+        (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper)
-                 (setf (aref new-network 1 n1-root) ; Update tree larger
+            (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node
-                       (+ (aref new-network 1 n1-root) (aref new-network 1 n2-root))))
+                   (setf (aref new-network 1 n1-root) ; Update tree larger
+                         (+ (aref new-network 1 n1-root) (aref new-network 1 n2-root))))
           (progn (setf (aref new-network 0 n1-root) (aref new-network 0 n2-root)) ; Otherwise modify the first node
                  (setf (aref new-network 1 n2-root) ; Update tree larger
                        (+ (aref new-network 1 n2-root) (aref new-network 1 n1-root)))))
-      new-network)))
+        (setf network new-network)))))
 
-
+(defmethod connected ((algo weighted-quick-union) n1 n2)
-;;; Macro definitions
-
-
-(defmacro wqu-connected (network n1 n2)
   "Return true if n1 and n2 are connected and nil otherwise. connection represent
 the find operation on the Quick Union algorithm"
-  `(= (wqu-find-root ,network ,n1) (wqu-find-root ,network ,n2)))
+  (with-slots ((network nw)) algo
-
+    (= (wqu-find-root network n1) (wqu-find-root network n2))))
-(defmacro wqu-nunion (network n1 n2)
-  "A destructive version of the union function."
-  `(setf ,network (wqu-union ,network ,n1 ,n2)))
-