diff --git a/lisp-algo.asd b/lisp-algo.asd index 73cc824..35b7b86 100644 --- a/lisp-algo.asd +++ b/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"))) diff --git a/packages.lisp b/packages.lisp index 62443df..c8dd0bc 100644 --- a/packages.lisp +++ b/packages.lisp @@ -5,31 +5,22 @@ (defpackage :com.lisp-algo.union-find (:use :common-lisp) (:nicknames :uf) - ;; Quick-Find - (:export :qf-create-network - :qf-union - :qf-connected) - ;; Quick-Union - (:export :qu-create-network - :qu-union - :qu-connected) - ;; Weighted-Quick-Union - (:export :wqu-create-network - :wqu-create-network - :wqu-union - :wqu-connected) - ;; Weighted-Quick-Union with Path Compression - (:export :wqupc-create-network - :wqupc-create-network - :wqupc-union - :wqupc-connected)) - - + (:shadow :union) + (:export :union + :connected + :quick-find ; Class + :quick-union ; Class + :weighted-quick-union ; Class + :weighted-quick-union-path-compression ; Class + :network ; Accessor + :network-size ; Accessor + :quick-union)) ;;; 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)) diff --git a/test/union-find.lisp b/test/union-find.lisp index 4bfa61d..36eeaee 100644 --- a/test/union-find.lisp +++ b/test/union-find.lisp @@ -12,57 +12,45 @@ ;;; Test create network -(define-test create-network-test () - ;; ----- Length tests - (dotimes (nw-size 1000) - (assert-equal nw-size (length (qf-create-network nw-size))) ; Quick-Find - (assert-equal nw-size (length (qu-create-network nw-size))) ; Quick-Union - ;; Weighted-Quick-Union - (assert-equal 10 (length (get-row (wqu-create-network 10) 0))) - (assert-equal 10 (length (get-row (wqu-create-network 10) 1))) - ;; Weighted-Quick-Union with Path Compression - (assert-equal 10 (length (get-row (wqupc-create-network 10) 0))) - (assert-equal 10 (length (get-row (wqupc-create-network 10) 1)))) - ;; ----- Value tests - (assert-equalp #(0 1 2 3 4) (qf-create-network 5)) ; Quick-Find - (assert-equalp #(0 1 2 3 4) (qu-create-network 5)) ; Quick-Union - ;; Weighted-Quick-Union - (assert-true (equalp #(0 1 2 3 4 5 6 7 8 9) (get-row (wqu-create-network 10) 0))) - (assert-true (equalp (make-array 10 :initial-element 1) (get-row (wqu-create-network 10) 1))) - ;; Weighted-Quick-Union with Path Compression - (assert-true (equalp #(0 1 2 3 4 5 6 7 8 9) (get-row (wqupc-create-network 10) 0))) - (assert-true (equalp (make-array 10 :initial-element 1) (get-row (wqupc-create-network 10) 1)))) - - -;; (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) +(define-test initialize-instance-test () + ;; ----- Network Length Tests + (dotimes (test-size 100) + (let* ((algo (make-instance 'quick-find :network-size test-size)) ; Quick Find + (nw (network algo)) + (nw-size (network-size algo))) + (assert-equal test-size nw-size) + (assert-equal test-size (length nw))) + (let* ((algo (make-instance 'quick-union :network-size test-size)) ; Quick Union + (nw (network algo)) + (nw-size (network-size algo))) + (assert-equal test-size nw-size) + (assert-equal test-size (length nw))) + (let* ((algo (make-instance 'weighted-quick-union :network-size test-size)) ; Weighted Quick Union + (nw (network algo)) + (nw-size (network-size algo))) + (assert-equal test-size nw-size) + (assert-equal test-size (length (get-row nw 0))) + (assert-equal test-size (length (get-row nw 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))) + (assert-equal test-size nw-size) + (assert-equal test-size (length (get-row nw 0))) + (assert-equal test-size (length (get-row nw 1))))) + ;; ----- Network Values Tests + (let* ((algo (make-instance 'quick-find :network-size 5)) ; Quick Find + (nw (network algo))) + (assert-true #(0 1 2 3 4) nw)) + (let* ((algo (make-instance 'quick-union :network-size 5)) ; Quick Union + (nw (network algo))) + (assert-true #(0 1 2 3 4) nw)) + (let* ((algo (make-instance 'weighted-quick-union :network-size 10)) ; Weighted Quick Union + (nw (network algo))) + (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)))) + (let* ((algo (make-instance 'weighted-quick-union-path-compression :network-size 10)) ; Weighted Quick Union Path Compression + (nw (network algo))) + (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))))) diff --git a/test/union-find/test-quick-find.lisp b/test/union-find/test-quick-find.lisp deleted file mode 100644 index f173ea6..0000000 --- a/test/union-find/test-quick-find.lisp +++ /dev/null @@ -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) - - diff --git a/union-find/quick-find.lisp b/union-find/quick-find.lisp index 936c647..dd2c54b 100644 --- a/union-find/quick-find.lisp +++ b/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) - "Build a quick-find network using a dynamic vector" - (let ((nodes (make-array n :fill-pointer 0))) - (dotimes (id n) +(defmethod initialize-instance :after ((algo quick-find) &key) + ;; Initialize network using dynamic vector + (let* ((nw-size (slot-value algo 'nw-size)) + (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 -(defun qf-union (network n1 n2) - "Link two nodes in the quick-find network. union_ represent the union operation of the Quick Find Algorithm" - (let ((v-n1 (elt network n1)) - (v-n2 (elt network n2)) - (new-network (copy-seq network))) +(defmethod union ((algo-instance quick-find) n1 n2) + (with-slots ((nw nw)) algo-instance + (let ((v-n1 (elt nw n1)) + (v-n2 (elt nw n2)) + (new-network (copy-seq nw))) (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 - -(defmacro qf-connected (network n1 n2) +(defmethod connected ((algo-instance quick-find) 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))) - -(defmacro qf-nunion (network n1 n2) - "A destructive version of union_" - `(setq ,network (union ,network ,n1 ,n2))) - + (with-slots ((nw nw)) algo-instance + (= (elt nw n1) (elt nw n2)))) diff --git a/union-find/quick-union.lisp b/union-find/quick-union.lisp index 0db2846..648aba4 100644 --- a/union-find/quick-union.lisp +++ b/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)) - (qu-find-root new-network n2)) - new-network)) + (setf (elt new-network (quick-union-find-root new-network n1)) + (quick-union-find-root new-network n2)) + (setf network new-network)))) - -;;; Macro definitions - -(defmacro qu-connected (network n1 n2) +(defmethod connected ((algo quick-union) 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))) - -(defmacro qu-nunion (network n1 n2) - "A destructive version of union_" - `(setf ,network (qu-union ,network ,n1 ,n2))) + (with-slots ((network nw)) algo + (= (quick-union-find-root network n1) (quick-union-find-root network n2)))) diff --git a/union-find/union-find.lisp b/union-find/union-find.lisp new file mode 100644 index 0000000..73f347f --- /dev/null +++ b/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")) diff --git a/union-find/weighted-quick-union-path-compression.lisp b/union-find/weighted-quick-union-path-compression.lisp index ee1fc31..7235cf2 100644 --- a/union-find/weighted-quick-union-path-compression.lisp +++ b/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 - (let* ((n1-root (wqupc-find-root new-network n1)) - (n2-root (wqupc-find-root new-network n2)) - (n1-size (aref new-network 1 n1-root)) - (n2-size (aref new-network 1 n2-root))) - (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper) - (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node - (setf (aref new-network 1 n1-root) ; Update tree larger - (+ (aref new-network 1 n1-root) (aref new-network 1 n2-root)))) + (with-slots ((network nw)) algo + (let ((new-network (copy-tree network))) ; Duplicate network + (let* ((n1-root (wqupc-find-root new-network n1)) + (n2-root (wqupc-find-root new-network n2)) + (n1-size (aref new-network 1 n1-root)) + (n2-size (aref new-network 1 n2-root))) + (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper) + (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node + (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)))) - -;;; Macro definitions - - -(defmacro wqupc-connected (network n1 n2) +(defmethod connected ((algo weighted-quick-union-path-compression) 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))) - -(defmacro wqupc-nunion (network n1 n2) - "A destructive version of the union function." - `(setf ,network (wqupc-union ,network ,n1 ,n2))) - + (with-slots ((network nw)) algo + (= (wqupc-find-root network n1) (wqupc-find-root network n2)))) diff --git a/union-find/weighted-quick-union.lisp b/union-find/weighted-quick-union.lisp index dc54a2d..3564288 100644 --- a/union-find/weighted-quick-union.lisp +++ b/union-find/weighted-quick-union.lisp @@ -9,15 +9,24 @@ (in-package :com.lisp-algo.union-find) -;;; Base functions -(defun wqu-create-network (n) - "Build a quick-find network using a multi-dimensional dynamic vector:\n +(defclass weighted-quick-union () + ((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 - (let* ((n1-root (wqu-find-root new-network n1)) - (n2-root (wqu-find-root new-network n2)) - (n1-size (aref new-network 1 n1-root)) - (n2-size (aref new-network 1 n2-root))) - (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper) - (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node - (setf (aref new-network 1 n1-root) ; Update tree larger - (+ (aref new-network 1 n1-root) (aref new-network 1 n2-root)))) + (with-slots ((network nw)) algo + (let ((new-network (copy-tree network))) ; Duplicate network + (let* ((n1-root (wqu-find-root new-network n1)) + (n2-root (wqu-find-root new-network n2)) + (n1-size (aref new-network 1 n1-root)) + (n2-size (aref new-network 1 n2-root))) + (if (>= n1-size n2-size) ; Check which subtree is LARGER (not deeper) + (progn (setf (aref new-network 0 n2-root) (aref new-network 0 n1-root)) ; Modify the second node + (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))))) - -;;; Macro definitions - - -(defmacro wqu-connected (network n1 n2) +(defmethod connected ((algo weighted-quick-union) 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))) - -(defmacro wqu-nunion (network n1 n2) - "A destructive version of the union function." - `(setf ,network (wqu-union ,network ,n1 ,n2))) - + (with-slots ((network nw)) algo + (= (wqu-find-root network n1) (wqu-find-root network n2))))