blob: 7235cf2e55d9dc74be6bcb85f5d1f3d877841b36 (
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
;;;; 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)
(defclass weighted-quick-union-path-compression ()
((nw-size
:initarg :network-size
:initform 10
:accessor network-size)
(nw
:initform nil
:accessor network)))
;;; Base functions
(defmethod initialize-instance :after ((algo weighted-quick-union-path-compression) &key)
"Build a quick-find network using a multi-dimensional dynamic vector:\n
1st dimension = the network\n 2nd dimension = each subtree node quantities"
(with-slots ((n nw-size) (nw nw)) algo
(let ((network (make-array `(2 ,n) :initial-element 1)))
(dotimes (id n)
(setf (aref network 0 id) id))
(setf nw 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))))
(defmethod union ((algo weighted-quick-union-path-compression) n1 n2)
"Connect to sub-tree together. union represent the union operation on the Quick Union algorithm"
(with-slots ((network nw)) algo
(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))))
(defmethod connected ((algo weighted-quick-union-path-compression) n1 n2)
"Return true if n1 and n2 are connected and nil otherwise. connection represent
the find operation on the Quick Union algorithm"
(with-slots ((network nw)) algo
(= (wqupc-find-root network n1) (wqupc-find-root network n2))))
|
