aboutsummaryrefslogtreecommitdiff
path: root/union-find/quick-union.lisp
blob: 0db2846bd23e58ff512f7de07605f2df7718005a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
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)))