From 5725987c8dfd55d4ee0282f0a37779e06052f3c6 Mon Sep 17 00:00:00 2001 From: Loic Guegan Date: Sun, 24 Feb 2019 10:30:57 +0100 Subject: Re-organize code --- lisp-algo.asd | 19 ++++++ packages.lisp | 35 +++++++++++ src/union-find/quick-find.lisp | 37 ------------ src/union-find/quick-union.lisp | 42 ------------- .../weighted-quick-union-path-compression.lisp | 59 ------------------- src/union-find/weighted-quick-union.lisp | 55 ----------------- test/test.lisp | 8 +++ test/union-find.lisp | 68 ++++++++++++++++++++++ test/union-find/test-quick-find.lisp | 45 ++++++++++++++ union-find/quick-find.lisp | 38 ++++++++++++ union-find/quick-union.lisp | 43 ++++++++++++++ .../weighted-quick-union-path-compression.lisp | 61 +++++++++++++++++++ union-find/weighted-quick-union.lisp | 57 ++++++++++++++++++ 13 files changed, 374 insertions(+), 193 deletions(-) create mode 100644 lisp-algo.asd create mode 100644 packages.lisp delete mode 100644 src/union-find/quick-find.lisp delete mode 100644 src/union-find/quick-union.lisp delete mode 100644 src/union-find/weighted-quick-union-path-compression.lisp delete mode 100644 src/union-find/weighted-quick-union.lisp create mode 100644 test/test.lisp create mode 100644 test/union-find.lisp create mode 100644 test/union-find/test-quick-find.lisp create mode 100644 union-find/quick-find.lisp create mode 100644 union-find/quick-union.lisp create mode 100644 union-find/weighted-quick-union-path-compression.lisp create mode 100644 union-find/weighted-quick-union.lisp 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/src/union-find/quick-find.lisp b/src/union-find/quick-find.lisp deleted file mode 100644 index edaa7f0..0000000 --- a/src/union-find/quick-find.lisp +++ /dev/null @@ -1,37 +0,0 @@ -;;;; Quick Find Algorithm -;;;; This algorithm solve dynamic connectivity -;;;; problem by providing a way to find if there -;;;; is a path between two nodes in a dynamic graph - - -;;; Base functions - -(defun 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)) - -;; Link two nodes in the network -(defun 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))) - (dotimes (n (length new-network)) - (if (= (elt new-network n) v-n2) (setf (elt new-network n) v-n1))) - new-network)) - -;;; Macro definitions - -(defmacro 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) - "A destructive version of union_" - `(setq ,network (union_ ,network ,n1 ,n2))) - - - diff --git a/src/union-find/quick-union.lisp b/src/union-find/quick-union.lisp deleted file mode 100644 index bf2ff3d..0000000 --- a/src/union-find/quick-union.lisp +++ /dev/null @@ -1,42 +0,0 @@ -;;;; Quick Union Algorithm -;;;; This algorithm solve dynamic connectivity -;;;; problem by providing a way to find if there -;;;; is a path between two nodes in a dynamic graph. -;;;; It is an improved version of the Quick Find algorithm -;;;; It optimize the union function - - -;;; Base functions - -(defun 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) - "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) - "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)) - new-network)) - - -;;; Macro definitions - -(defmacro 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))) - -(defmacro nunion_ (network n1 n2) - "A destructive version of union_" - `(setf ,network (union_ ,network ,n1 ,n2))) - diff --git a/src/union-find/weighted-quick-union-path-compression.lisp b/src/union-find/weighted-quick-union-path-compression.lisp deleted file mode 100644 index 56c80b7..0000000 --- a/src/union-find/weighted-quick-union-path-compression.lisp +++ /dev/null @@ -1,59 +0,0 @@ -;;;; Weighted Quick Union Algorithm With Path Compression -;;;; This algorithm solve dynamic connectivity -;;;; problem by providing a way to find if there -;;;; is a path between two nodes in a dynamic graph. -;;;; It is an improved version of the Quick Union algorithm -;;;; by improving the way that the union-tree is constructed -;;;; The algorithm try to reduce the deepness of the tree in -;;;; order to optimize the find-root function -;;;; The path compression is ensure by the find-root function -;;;; IMPORTANT: find-root is now a destructive function ! Be aware... - -;;; Base functions - -(defun 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))) - (dotimes (id n) - (setf (aref network 0 id) id)) - network)) - -(defun 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) - (value (aref network 0 node) (aref network 0 value))) - ((= id value) (progn (setf (aref network 0 node) id) ; Path compression - id)))) - -(defun 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)) - (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))) - - -;;; Macro definitions - - -(defmacro 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))) - -(defmacro nunion_ (network n1 n2) - "A destructive version of the union function." - `(setf ,network (union_ ,network ,n1 ,n2))) - - diff --git a/src/union-find/weighted-quick-union.lisp b/src/union-find/weighted-quick-union.lisp deleted file mode 100644 index 679de80..0000000 --- a/src/union-find/weighted-quick-union.lisp +++ /dev/null @@ -1,55 +0,0 @@ -;;;; Weighted Quick Union Algorithm -;;;; This algorithm solve dynamic connectivity -;;;; problem by providing a way to find if there -;;;; is a path between two nodes in a dynamic graph. -;;;; It is an improved version of the Quick Union algorithm -;;;; by improving the way that the union-tree is constructed -;;;; The algorithm try to reduce the deepness of the tree in -;;;; order to optimize the find-root function - -;;; Base functions - -(defun 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))) - (dotimes (id n) - (setf (aref network 0 id) id)) - network)) - -(defun 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) - "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)) - (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))) - - -;;; Macro definitions - - -(defmacro 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))) - -(defmacro nunion_ (network n1 n2) - "A destructive version of the union function." - `(setf ,network (union_ ,network ,n1 ,n2))) - - 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/union-find/quick-find.lisp b/union-find/quick-find.lisp new file mode 100644 index 0000000..936c647 --- /dev/null +++ b/union-find/quick-find.lisp @@ -0,0 +1,38 @@ +;;;; Quick Find Algorithm +;;;; This algorithm solve dynamic connectivity +;;;; 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 qf-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)) + +;; 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))) + (dotimes (n (length new-network)) + (if (= (elt new-network n) v-n2) (setf (elt new-network n) v-n1))) + new-network)) + +;;; Macro definitions + +(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 qf-nunion (network n1 n2) + "A destructive version of union_" + `(setq ,network (union ,network ,n1 ,n2))) + + + diff --git a/union-find/quick-union.lisp b/union-find/quick-union.lisp new file mode 100644 index 0000000..0db2846 --- /dev/null +++ b/union-find/quick-union.lisp @@ -0,0 +1,43 @@ +;;;; Quick Union Algorithm +;;;; This algorithm solve dynamic connectivity +;;;; problem by providing a way to find if there +;;;; is a path between two nodes in a dynamic graph. +;;;; 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 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 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 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 (qu-find-root new-network n1)) + (qu-find-root new-network n2)) + new-network)) + + +;;; Macro definitions + +(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" + `(= (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))) + diff --git a/union-find/weighted-quick-union-path-compression.lisp b/union-find/weighted-quick-union-path-compression.lisp new file mode 100644 index 0000000..ee1fc31 --- /dev/null +++ b/union-find/weighted-quick-union-path-compression.lisp @@ -0,0 +1,61 @@ +;;;; Weighted Quick Union Algorithm With Path Compression +;;;; This algorithm solve dynamic connectivity +;;;; problem by providing a way to find if there +;;;; is a path between two nodes in a dynamic graph. +;;;; It is an improved version of the Quick Union algorithm +;;;; by improving the way that the union-tree is constructed +;;;; The algorithm try to reduce the deepness of the tree in +;;;; order to optimize the find-root function +;;;; 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 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))) + (dotimes (id n) + (setf (aref network 0 id) id)) + 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 +include path compression" + (do ((id node value) + (value (aref network 0 node) (aref network 0 value))) + ((= id value) (progn (setf (aref network 0 node) id) ; Path compression + id)))) + +(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 (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))) + + +;;; Macro definitions + + +(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" + `(= (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))) + + diff --git a/union-find/weighted-quick-union.lisp b/union-find/weighted-quick-union.lisp new file mode 100644 index 0000000..dc54a2d --- /dev/null +++ b/union-find/weighted-quick-union.lisp @@ -0,0 +1,57 @@ +;;;; Weighted Quick Union Algorithm +;;;; This algorithm solve dynamic connectivity +;;;; problem by providing a way to find if there +;;;; is a path between two nodes in a dynamic graph. +;;;; It is an improved version of the Quick Union algorithm +;;;; by improving the way that the union-tree is constructed +;;;; 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 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))) + (dotimes (id n) + (setf (aref network 0 id) id)) + network)) + +(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 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 (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))) + + +;;; Macro definitions + + +(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" + `(= (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))) + + -- cgit v1.2.3