47 lines
2 KiB
Common Lisp
47 lines
2 KiB
Common Lisp
;; 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)))
|
|
|
|
|