aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLoic Guegan <manzerberdes@gmx.com>2019-02-24 20:33:55 +0100
committerLoic Guegan <manzerberdes@gmx.com>2019-02-24 20:33:55 +0100
commitb256fc334a6c8868a6159f32adb6dba01fefca86 (patch)
treef98e6dcf0957b3f68502d7f7142e8c218596868d
parent5725987c8dfd55d4ee0282f0a37779e06052f3c6 (diff)
Add CLOS to union-findHEADmaster
-rw-r--r--lisp-algo.asd5
-rw-r--r--packages.lisp33
-rw-r--r--test/union-find.lisp92
-rw-r--r--test/union-find/test-quick-find.lisp45
-rw-r--r--union-find/quick-find.lisp47
-rw-r--r--union-find/quick-union.lisp39
-rw-r--r--union-find/union-find.lisp10
-rw-r--r--union-find/weighted-quick-union-path-compression.lisp54
-rw-r--r--union-find/weighted-quick-union.lisp54
9 files changed, 169 insertions, 210 deletions
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
-
-(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)
+(defclass quick-find ()
+ ((nw-size
+ :initarg :network-size
+ :initform 10
+ :accessor network-size)
+ (nw
+ :initform nil
+ :accessor network)))
+
+(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))
-
-;;; Macro definitions
+ (setf nw new-network))))
-(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
-
-(defun qu-create-network (n)
+(defclass quick-union ()
+ ((nw-size
+ :initarg :network-size
+ :initform 10
+ :accessor network-size)
+ (nw
+ :initarg nil
+ :accessor network)))
+
+(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))))