From 5725987c8dfd55d4ee0282f0a37779e06052f3c6 Mon Sep 17 00:00:00 2001 From: Loic Guegan Date: Sun, 24 Feb 2019 10:30:57 +0100 Subject: [PATCH] Re-organize code --- lisp-algo.asd | 19 ++++++ packages.lisp | 35 ++++++++++ test/test.lisp | 8 +++ test/union-find.lisp | 68 +++++++++++++++++++ test/union-find/test-quick-find.lisp | 45 ++++++++++++ .../union-find => union-find}/quick-find.lisp | 11 +-- .../quick-union.lisp | 19 +++--- ...weighted-quick-union-path-compression.lisp | 20 +++--- .../weighted-quick-union.lisp | 20 +++--- 9 files changed, 213 insertions(+), 32 deletions(-) create mode 100644 lisp-algo.asd create mode 100644 packages.lisp create mode 100644 test/test.lisp create mode 100644 test/union-find.lisp create mode 100644 test/union-find/test-quick-find.lisp rename {src/union-find => union-find}/quick-find.lisp (81%) rename {src/union-find => union-find}/quick-union.lisp (69%) rename {src/union-find => union-find}/weighted-quick-union-path-compression.lisp (83%) rename {src/union-find => union-find}/weighted-quick-union.lisp (81%) 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)))