Re-organize code

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")))))
+                                       
+                          

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))
+

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))

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)
+
+

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)
+
+

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)))
 
 
 

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))
+    (setf (elt new-network (qu-find-root new-network n1))
-          (find-root new-network n2))
+          (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)))
 

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))
+    (let* ((n1-root (wqupc-find-root new-network n1))
-          (n2-root (find-root new-network n2))
+          (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)))
 
 

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))
+    (let* ((n1-root (wqu-find-root new-network n1))
-          (n2-root (find-root new-network n2))
+          (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)))