1 files changed, 43 insertions, 0 deletions
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)))
+