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 --- 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 ++++++++++++++++++++ 4 files changed, 199 insertions(+) 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 (limited to 'union-find') 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