Skip to content

Commit cba0527

Browse files
garlic0x1garlic0x1
committed
rotato
1 parent ed4d20c commit cba0527

File tree

3 files changed

+104
-32
lines changed

3 files changed

+104
-32
lines changed

‎dev/benchmark.lisp

+3
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,9 @@
2626
(with-open-file (s *readme*)
2727
(let* ((starting-rope (split-rope (make-rope s) 1000))
2828
(rope starting-rope))
29+
(dotimes (i 9999)
30+
(setf rope (concat-rope rope starting-rope)))
31+
(setf starting-rope rope)
2932
(dotimes (i 100)
3033
(print-time
3134
(time*

‎dev/graphviz.lisp

+10-3
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
(defparameter *string* "In computer programming, a rope, or cord, is a data structure composed of smaller strings that is used to efficiently store and manipulate longer strings or entire texts.")
44

55
(defparameter rope::*long-leaf* 24)
6-
(defparameter rope::*short-leaf* 8)
6+
(defparameter rope::*short-leaf* 2)
77

88
(defclass root ()
99
((name :initarg :name :accessor root-name)
@@ -15,7 +15,7 @@
1515
:attributes `(:label ,(format nil "rope: ~a~%length: ~a~%depth: ~a"
1616
(root-name root)
1717
(rope-length obj)
18-
(rope-depth obj))
18+
(rope::rope-depth obj))
1919
:style :filled))))
2020

2121
(defmethod graph-object-points-to ((self (eql 'rope)) (obj root))
@@ -26,7 +26,7 @@
2626
(make-instance 'node
2727
:attributes `(:label ,(format nil "length: ~a~%depth: ~a"
2828
(rope-length obj)
29-
(rope-depth obj)))))
29+
(rope::rope-depth obj)))))
3030

3131
(defmethod graph-object-points-to ((self (eql 'rope)) (obj rope::branch))
3232
(list (make-instance 'attributed
@@ -75,3 +75,10 @@
7575
(setf rope (append-rope rope " we can do it again"))
7676
(setf rope (append-rope rope " later!"))
7777
(graph-ropes (list rope)))
78+
79+
#+example
80+
(let ((rope (rope::make-rope "hello world")))
81+
(dotimes (i 10)
82+
(setf rope (rope:append-rope rope "!")))
83+
(graph-ropes (list (rope::balance-rope rope)
84+
)))

‎rope.lisp

+91-29
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,77 @@
101101
;; Balancing ;;
102102
;;-----------;;
103103

104+
;; Balance: -2
105+
;; Left Rotation
106+
;; a c
107+
;; / \ / \
108+
;; b c a e
109+
;; / \ / \ / \
110+
;; d e b d f g
111+
;; / \
112+
;; f g
113+
114+
;; Balance: 2
115+
;; Right Rotation
116+
;; a b
117+
;; / \ / \
118+
;; b c d a
119+
;; / \ / \ / \
120+
;; d e f g e c
121+
;; / \
122+
;; f g
123+
124+
(defgeneric rotate (rope direction)
125+
(:method ((rope branch) (direction (eql :left)))
126+
(with-slots (left right) rope
127+
(concat-rope*
128+
(concat-rope* left (branch-left right))
129+
(branch-right right))))
130+
(:method ((rope branch) (direction (eql :right)))
131+
(with-slots (left right) rope
132+
(concat-rope*
133+
(branch-left left)
134+
(concat-rope* (branch-right left) right)))))
135+
136+
(defmethod rotate :around (rope direction)
137+
(format t "rope: ~a, rotating: ~a~%" (write-rope rope nil) direction)
138+
(call-next-method))
139+
140+
(defgeneric balance-direction (rope)
141+
(:method ((rope leaf))
142+
nil)
143+
(:method ((rope branch))
144+
(with-slots (left right) rope
145+
(let ((balance (- (rope-depth left) (rope-depth right))))
146+
(cond ((< 1 balance) :right)
147+
((> -1 balance) :left)
148+
(t nil))))))
149+
150+
;; (defmethod balance :around (rope)
151+
;; (let ((bal (call-next-method)))
152+
;; (format t "rope: ~a, balance: ~a~%" (write-rope rope nil) bal)
153+
;; bal))
154+
155+
(defgeneric balance-rope (rope)
156+
(:method ((rope leaf))
157+
rope)
158+
(:method ((rope branch))
159+
(with-slots (left right) rope
160+
(let* ((left (if (balance-direction left) (balance-rope left) left))
161+
(right (if (balance-direction right) (balance-rope right) right))
162+
(rope (concat-rope* left right))
163+
(balance (balance rope)))
164+
(cond ((< 1 balance)
165+
(rotate rope :right))
166+
((> -1 balance)
167+
(rotate rope :left))
168+
(t
169+
rope))))))
170+
171+
;;---------;;
172+
;; Rebuild ;;
173+
;;---------;;
174+
104175
(defun normalize-leaves (leaves &optional carry)
105176
(let ((leaf (car leaves)))
106177
(cond ((and carry (null leaf))
@@ -115,16 +186,6 @@
115186
(t
116187
(cons leaf (normalize-leaves (cdr leaves)))))))
117188

118-
(defgeneric balancedp (rope)
119-
(:documentation "Check if a rope is a height-balanced tree.")
120-
(:method ((rope leaf))
121-
t)
122-
(:method ((rope branch))
123-
(with-slots (left right) rope
124-
(and (balancedp left)
125-
(balancedp right)
126-
(>= 2 (abs (- (rope-depth left) (rope-depth right))))))))
127-
128189
(defun merge-leaves (leaves start end)
129190
(let ((range (- end start)))
130191
(case range
@@ -134,30 +195,28 @@
134195
(concat-rope (merge-leaves leaves start mid)
135196
(merge-leaves leaves mid end)))))))
136197

137-
(defun balance-rope (rope &optional forcep)
198+
(defun rebuild-rope (rope)
138199
"Balance a rope by reconstructing it from the bottom up."
139-
(if (and (balancedp rope) (not forcep))
140-
rope
141-
(let ((leaves (normalize-leaves (collect-rope rope))))
142-
(merge-leaves leaves 0 (length leaves)))))
200+
(let ((leaves (normalize-leaves (collect-rope rope))))
201+
(merge-leaves leaves 0 (length leaves))))
143202

144203
;;--------;;
145204
;; Insert ;;
146205
;;--------;;
147206

148207
(defgeneric prepend-rope (rope source)
149208
(:documentation "Return a new rope with a string or rope inserted at the beginning of a rope.")
150-
(:method (rope (source string))
151-
(concat-rope (make-rope source) rope))
152209
(:method (rope (source rope))
153-
(concat-rope source rope)))
210+
(concat-rope source rope))
211+
(:method (rope (source t))
212+
(concat-rope (make-rope source) rope)))
154213

155214
(defgeneric append-rope (rope source)
156215
(:documentation "Return a new rope with a string or rope inserted at the end of a rope.")
157-
(:method (rope (source string))
158-
(concat-rope rope (make-rope source)))
159216
(:method (rope (source rope))
160-
(concat-rope rope source)))
217+
(concat-rope rope source))
218+
(:method (rope (source t))
219+
(concat-rope rope (make-rope source))))
161220

162221
(defun insert-rope (rope index str)
163222
"Return a new rope with a string or rope inserted at the specified index of a rope."
@@ -192,14 +251,17 @@
192251
;; Concat ;;
193252
;;--------;;
194253

254+
(defun concat-rope* (left right)
255+
"Concatenates without balancing."
256+
(make-instance 'branch
257+
:length (+ (rope-length left) (rope-length right))
258+
:depth (1+ (max (rope-depth left) (rope-depth right)))
259+
:left left
260+
:right right))
261+
195262
(defun concat-rope (left right)
196263
"Returns a balanced concatenation of two ropes."
197-
(balance-rope
198-
(make-instance 'branch
199-
:length (+ (rope-length left) (rope-length right))
200-
:depth (1+ (max (rope-depth left) (rope-depth right)))
201-
:left left
202-
:right right)))
264+
(balance-rope (concat-rope* left right)))
203265

204266
;;-------;;
205267
;; Split ;;
@@ -218,10 +280,10 @@
218280
((< index weight)
219281
(multiple-value-bind (ante post) (split-rope left index)
220282
(values (balance-rope ante)
221-
(balance-rope (concat-rope post right)))))
283+
(concat-rope post right))))
222284
((> index weight)
223285
(multiple-value-bind (ante post) (split-rope right (- index weight))
224-
(values (balance-rope (concat-rope left ante))
286+
(values (concat-rope left ante)
225287
(balance-rope post)))))))))
226288

227289
;;------;;

0 commit comments

Comments
 (0)