34 lines
1.1 KiB
Common Lisp
34 lines
1.1 KiB
Common Lisp
|
;; 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)))
|
||
|
|
|