aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/quick-find.lisp30
-rw-r--r--src/quick-union.lisp33
-rw-r--r--src/weighted-quick-union.lisp47
3 files changed, 110 insertions, 0 deletions
diff --git a/src/quick-find.lisp b/src/quick-find.lisp
new file mode 100644
index 0000000..dd371b8
--- /dev/null
+++ b/src/quick-find.lisp
@@ -0,0 +1,30 @@
+;; Create network nodes
+(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))
+
+;; Check if two nodes are connected
+(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)))
+
+;; 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))
+
+;; Union consing version
+(defmacro nunion_ (network n1 n2)
+ "A cosing version of union_"
+ `(setq ,network (union_ ,network ,n1 ,n2)))
+
+
+
diff --git a/src/quick-union.lisp b/src/quick-union.lisp
new file mode 100644
index 0000000..ca61703
--- /dev/null
+++ b/src/quick-union.lisp
@@ -0,0 +1,33 @@
+;; Create network nodes
+(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))
+
+;; Find the root of a node
+(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)))
+
+;; Check if two nodes are connected
+(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)))
+
+;; Link two nodes together
+(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))
+
+;; A consed version of union_
+(defmacro nunion_ (network n1 n2)
+ `(setf ,network (union_ ,network ,n1 ,n2)))
+
diff --git a/src/weighted-quick-union.lisp b/src/weighted-quick-union.lisp
new file mode 100644
index 0000000..16b1aa5
--- /dev/null
+++ b/src/weighted-quick-union.lisp
@@ -0,0 +1,47 @@
+;; Create network nodes: A two dimensionnal array.
+;; 1st dimension = the network
+;; 2nd dimension = each subtree node quantities
+(defun create-network (n)
+ "Build a quick-find network using a multi-dimensional dynamic vector"
+ (let ((network (make-array `(2 ,n) :initial-element 1)))
+ (dotimes (id n)
+ (setf (aref network 0 id) id))
+ network))
+
+;; Find the root of a node
+(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)))
+
+;; Check if two nodes are connected
+(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)))
+
+;; Link two nodes together
+(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)))
+
+
+
+;; A consed version of union_
+(defmacro nunion_ (network n1 n2)
+ `(setf ,network (union_ ,network ,n1 ,n2)))
+
+