-
Notifications
You must be signed in to change notification settings - Fork 20
/
offline-dynamic-connectivity.lisp
143 lines (134 loc) · 5.84 KB
/
offline-dynamic-connectivity.lisp
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
;;;
;;; Offline dynamic connectivity
;;;
(defpackage :cp/offline-dynamic-connectivity
(:use :cl :cp/undoable-disjoint-set)
(:export #:dynamic-connectivity #:make-dynamic-connectivity
#:dycon-insert #:dycon-delete #:dycon-build #:dycon-map
#:dycon-num-components #:dycon-disjoint-set))
(in-package :cp/offline-dynamic-connectivity)
;; NOTE: not tested
;; NOTE: MAX-TIME must be positive.
(define-undoable-disjoint-set undoable-disjoint-set
:conc-name uds-)
(defstruct (dynamic-connectivity
(:constructor make-dynamic-connectivity
(size max-time
&aux (segtree (make-array (- (* 2 max-time) 1) :element-type 'list :initial-element nil))
(counter (make-hash-table :test #'equal))
(appearance (make-hash-table :test #'equal))
(events (make-array 0 :element-type 'list :fill-pointer 0))
(disjoint-set (make-undoable-disjoint-set size :buffer-size max-time))
(num-components size)))
(:copier nil)
(:predicate nil)
(:conc-name dycon-))
(size 0 :type (integer 0 #.most-positive-fixnum))
(max-time 0 :type (integer 1 #.most-positive-fixnum))
(last-time 0 :type (integer 0 #.most-positive-fixnum))
(segtree nil :type (simple-array list (*)))
(counter nil :type hash-table)
(appearance nil :type hash-table)
;; (appear-time disappear-time vertex1 . vertex2)
(events nil :type (array list (*)))
;; disjoint set that holds connectivity of graph
(disjoint-set nil :type undoable-disjoint-set)
;; number of connected components
(num-components 0 :type (integer 0 #.most-positive-fixnum)))
(defun dycon-insert (dycon u v time)
"Inserts an edge {u, v} at TIME."
(declare (optimize (speed 3))
((integer 0 #.most-positive-fixnum) u v time))
(symbol-macrolet ((last-time (dycon-last-time dycon))
(counter (dycon-counter dycon))
(appearance (dycon-appearance dycon)))
(assert (>= time last-time))
(setf last-time time)
(when (> u v) (rotatef u v))
(let* ((edge (cons u v))
(count (gethash edge counter)))
(declare ((or null (integer 0 #.most-positive-fixnum)) count))
(if count
(setf (gethash edge counter) (+ count 1))
(setf (gethash edge appearance) time
(gethash edge counter) 1)))))
(defun dycon-delete (dycon u v time)
"Deletes an edge {u, v} at TIME."
(declare (optimize (speed 3))
((integer 0 #.most-positive-fixnum) u v time))
(symbol-macrolet ((last-time (dycon-last-time dycon))
(counter (dycon-counter dycon))
(appearance (dycon-appearance dycon))
(events (dycon-events dycon)))
(assert (>= time last-time))
(setf last-time time)
(when (> u v) (rotatef u v))
(let* ((edge (cons u v))
(count (gethash edge counter)))
(declare ((or null (integer 0 #.most-positive-fixnum)) count))
(assert count () "Attempted to delete non-existent edge (~W . ~W) at time ~W"
u v time)
(if (= count 1)
(let ((appear-time (gethash edge appearance)))
(remhash edge counter)
(unless (eql appear-time time)
(vector-push-extend (list* appear-time time edge) events)))
(setf (gethash edge counter) (- count 1))))))
(defun %dycon-update (dycon edge l r)
(declare (optimize (speed 3))
((integer 0 #.most-positive-fixnum) l r))
(let ((segtree (dycon-segtree dycon))
(max-time (dycon-max-time dycon)))
(incf l (- max-time 1))
(incf r (- max-time 1))
(loop while (< l r)
when (evenp l)
do (push edge (aref segtree l))
(incf l)
when (evenp r)
do (decf r)
(push edge (aref segtree r))
do (setq l (ash (- l 1) -1)
r (ash (- r 1) -1)))))
(defun dycon-build (dycon)
(declare (optimize (speed 3)))
(let ((counter (dycon-counter dycon))
(events (dycon-events dycon))
(appearance (dycon-appearance dycon))
(max-time (dycon-max-time dycon)))
(maphash (lambda (edge count)
(declare (ignore count))
(let ((appear-time (gethash edge appearance)))
(vector-push-extend (list* appear-time max-time edge) events)))
counter)
(loop for (appear-time disappear-time u . v) across events
do (%dycon-update dycon (cons u v) appear-time disappear-time))
dycon))
;; TODO: safeguard against calling DYCON-MAP before DYCON-BUILD
(defun dycon-map (dycon function)
"FUCTION takes time as an argument: When FUNCTION is called, NUM-COMPONENTS
and DISJOINT-SET take a state immediately after the time. Be sure to call
DYCON-BUILD beforehand."
(declare (optimize (speed 3))
(function function))
(symbol-macrolet ((comp (dycon-num-components dycon)))
(let* ((disjoint-set (dycon-disjoint-set dycon))
(segtree (dycon-segtree dycon))
(max-time (dycon-max-time dycon)))
(labels ((recur (i)
(declare ((integer 0 #.most-positive-fixnum) i))
(let ((comp-delta 0))
(declare ((integer 0 #.most-positive-fixnum) comp-delta))
(loop for (u . v) in (aref segtree i)
when (uds-unite! disjoint-set u v)
do (incf comp-delta))
(decf comp comp-delta)
(if (< i (- max-time 1))
(progn
(recur (+ 1 (* 2 i)))
(recur (+ 2 (* 2 i))))
(funcall function (- i (- max-time 1))))
(incf comp comp-delta)
(loop for edge in (aref segtree i)
do (uds-undo! disjoint-set)))))
(recur 0)))))