43 lines
1.4 KiB
Common Lisp
43 lines
1.4 KiB
Common Lisp
;;;; 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)))
|
|
|