diff --git a/lisp-algo.asd b/lisp-algo.asd
new file mode 100644
index 0000000..73cc824
--- /dev/null
+++ b/lisp-algo.asd
@@ -0,0 +1,19 @@
+;;;; Define ASDF system
+(defsystem "lisp-algo"
+ :description "Provide several lisp algorithms"
+ :version "0.0.1"
+ :depends-on ("lisp-unit")
+ :perform (test-op (o s) (symbol-call :com.lisp-algo.test :do-tests))
+ :components ((:file "packages")
+ (:module "union-find"
+ :depends-on ("packages")
+ :components ((:file "quick-find")
+ (:file "quick-union")
+ (:file "weighted-quick-union")
+ (:file "weighted-quick-union-path-compression")))
+ (:module "test"
+ :depends-on ("packages")
+ :components ((:file "test")
+ (:file "union-find")))))
+
+
diff --git a/packages.lisp b/packages.lisp
new file mode 100644
index 0000000..62443df
--- /dev/null
+++ b/packages.lisp
@@ -0,0 +1,35 @@
+;;;; This file contains lisp-algos packages definitions
+
+;;; Union-Find packages
+
+(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))
+
+
+;;; Unit tests
+
+(defpackage :com.lisp-algo.test
+ (:use :common-lisp
+ :lisp-unit
+ :com.lisp-algo.union-find)
+ (:export :get-row))
+
diff --git a/test/test.lisp b/test/test.lisp
new file mode 100644
index 0000000..f672045
--- /dev/null
+++ b/test/test.lisp
@@ -0,0 +1,8 @@
+(in-package :com.lisp-algo.test)
+
+(defun do-tests ()
+ "Configure lisp-unit and run all tests."
+ (setq *print-errors* t) ; Details tests locations when running tests
+ (setq *print-summary* t) ; Details on tests
+ (setq *print-failures* t) ; Details tests locations when failures
+ (run-tests :all :com.lisp-algo.test))
diff --git a/test/union-find.lisp b/test/union-find.lisp
new file mode 100644
index 0000000..4bfa61d
--- /dev/null
+++ b/test/union-find.lisp
@@ -0,0 +1,68 @@
+(in-package :com.lisp-algo.test)
+
+
+;;; Utils
+(defun get-row (array &optional (row-id 0))
+ (let* ((row-size (array-dimension array 1)) ; Deduce row size from array
+ (row (make-array row-size :fill-pointer 0))) ; Initialize a new vector (which will contain the row row-id from array)
+ ;; Fill row with the right values of array
+ (do ((cur-id 0 (+ cur-id 1)))
+ ((>= cur-id row-size) row)
+ (vector-push (row-major-aref array (+ cur-id (* row-size row-id ))) row))))
+
+
+;;; 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)
+
+
diff --git a/test/union-find/test-quick-find.lisp b/test/union-find/test-quick-find.lisp
new file mode 100644
index 0000000..f173ea6
--- /dev/null
+++ b/test/union-find/test-quick-find.lisp
@@ -0,0 +1,45 @@
+(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/src/union-find/quick-find.lisp b/union-find/quick-find.lisp
similarity index 81%
rename from src/union-find/quick-find.lisp
rename to union-find/quick-find.lisp
index edaa7f0..936c647 100644
--- a/src/union-find/quick-find.lisp
+++ b/union-find/quick-find.lisp
@@ -3,10 +3,11 @@
;;;; problem by providing a way to find if there
;;;; is a path between two nodes in a dynamic graph
+(in-package :com.lisp-algo.union-find)
;;; Base functions
-(defun create-network (n)
+(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)
@@ -14,7 +15,7 @@
nodes))
;; Link two nodes in the network
-(defun union_ (network n1 n2)
+(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))
@@ -25,13 +26,13 @@
;;; Macro definitions
-(defmacro connected (network 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)))
-(defmacro nunion_ (network n1 n2)
+(defmacro qf-nunion (network n1 n2)
"A destructive version of union_"
- `(setq ,network (union_ ,network ,n1 ,n2)))
+ `(setq ,network (union ,network ,n1 ,n2)))
diff --git a/src/union-find/quick-union.lisp b/union-find/quick-union.lisp
similarity index 69%
rename from src/union-find/quick-union.lisp
rename to union-find/quick-union.lisp
index bf2ff3d..0db2846 100644
--- a/src/union-find/quick-union.lisp
+++ b/union-find/quick-union.lisp
@@ -5,38 +5,39 @@
;;;; It is an improved version of the Quick Find algorithm
;;;; It optimize the union function
+(in-package :com.lisp-algo.union-find)
;;; Base functions
-(defun create-network (n)
+(defun qu-create-network (n)
"Build a quick-find network using a dynamic vector"
(let ((nodes (make-array n :fill-pointer 0)))
(dotimes (id n)
(vector-push id nodes))
nodes))
-(defun find-root (network node)
+(defun qu-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 union_ (network n1 n2)
+(defun qu-union (network n1 n2)
"Connect to sub-tree together. union represent the union operation on the Quick Union algorithm"
(let ((new-network (copy-seq network)))
- (setf (elt new-network (find-root new-network n1))
- (find-root new-network n2))
+ (setf (elt new-network (qu-find-root new-network n1))
+ (qu-find-root new-network n2))
new-network))
;;; Macro definitions
-(defmacro connected (network n1 n2)
+(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"
- `(= (find-root ,network ,n1) (find-root ,network ,n2)))
+ `(= (qu-find-root ,network ,n1) (qu-find-root ,network ,n2)))
-(defmacro nunion_ (network n1 n2)
+(defmacro qu-nunion (network n1 n2)
"A destructive version of union_"
- `(setf ,network (union_ ,network ,n1 ,n2)))
+ `(setf ,network (qu-union ,network ,n1 ,n2)))
diff --git a/src/union-find/weighted-quick-union-path-compression.lisp b/union-find/weighted-quick-union-path-compression.lisp
similarity index 83%
rename from src/union-find/weighted-quick-union-path-compression.lisp
rename to union-find/weighted-quick-union-path-compression.lisp
index 56c80b7..ee1fc31 100644
--- a/src/union-find/weighted-quick-union-path-compression.lisp
+++ b/union-find/weighted-quick-union-path-compression.lisp
@@ -9,9 +9,11 @@
;;;; The path compression is ensure by the find-root function
;;;; IMPORTANT: find-root is now a destructive function ! Be aware...
+(in-package :com.lisp-algo.union-find)
+
;;; Base functions
-(defun create-network (n)
+(defun wqupc-create-network (n)
"Build a quick-find network using a multi-dimensional dynamic vector:\n
1st dimension = the network\n 2nd dimension = each subtree node quantities"
(let ((network (make-array `(2 ,n) :initial-element 1)))
@@ -19,7 +21,7 @@
(setf (aref network 0 id) id))
network))
-(defun find-root (network node)
+(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
include path compression"
(do ((id node value)
@@ -27,11 +29,11 @@ include path compression"
((= id value) (progn (setf (aref network 0 node) id) ; Path compression
id))))
-(defun union_ (network n1 n2)
+(defun wqupc-union (network 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 (find-root new-network n1))
- (n2-root (find-root new-network n2))
+ (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)
@@ -47,13 +49,13 @@ include path compression"
;;; Macro definitions
-(defmacro connected (network n1 n2)
+(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"
- `(= (find-root ,network ,n1) (find-root ,network ,n2)))
+ `(= (wqupc-find-root ,network ,n1) (wqupc-find-root ,network ,n2)))
-(defmacro nunion_ (network n1 n2)
+(defmacro wqupc-nunion (network n1 n2)
"A destructive version of the union function."
- `(setf ,network (union_ ,network ,n1 ,n2)))
+ `(setf ,network (wqupc-union ,network ,n1 ,n2)))
diff --git a/src/union-find/weighted-quick-union.lisp b/union-find/weighted-quick-union.lisp
similarity index 81%
rename from src/union-find/weighted-quick-union.lisp
rename to union-find/weighted-quick-union.lisp
index 679de80..dc54a2d 100644
--- a/src/union-find/weighted-quick-union.lisp
+++ b/union-find/weighted-quick-union.lisp
@@ -7,9 +7,11 @@
;;;; The algorithm try to reduce the deepness of the tree in
;;;; order to optimize the find-root function
+(in-package :com.lisp-algo.union-find)
+
;;; Base functions
-(defun create-network (n)
+(defun wqu-create-network (n)
"Build a quick-find network using a multi-dimensional dynamic vector:\n
1st dimension = the network\n 2nd dimension = each subtree node quantities"
(let ((network (make-array `(2 ,n) :initial-element 1)))
@@ -17,17 +19,17 @@
(setf (aref network 0 id) id))
network))
-(defun find-root (network node)
+(defun wqu-find-root (network node)
"Find the root of a sub-tree in the network."
(do ((id node value)
(value (aref network 0 node) (aref network 0 value)))
((= id value) id)))
-(defun union_ (network n1 n2)
+(defun wqu-union-union (network 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 (find-root new-network n1))
- (n2-root (find-root new-network n2))
+ (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)
@@ -43,13 +45,13 @@
;;; Macro definitions
-(defmacro connected (network n1 n2)
+(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"
- `(= (find-root ,network ,n1) (find-root ,network ,n2)))
+ `(= (wqu-find-root ,network ,n1) (wqu-find-root ,network ,n2)))
-(defmacro nunion_ (network n1 n2)
+(defmacro wqu-nunion (network n1 n2)
"A destructive version of the union function."
- `(setf ,network (union_ ,network ,n1 ,n2)))
+ `(setf ,network (wqu-union ,network ,n1 ,n2)))