Re-organize code

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)))
+
+
+

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)))
+

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)))
+
+

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)))
+
+