diff --git a/dev/benchmark.lisp b/dev/benchmark.lisp new file mode 100644 index 0000000..2e6c73f --- /dev/null +++ b/dev/benchmark.lisp @@ -0,0 +1,40 @@ +(in-package #:rope/dev) + +;; (progn +;; (sb-ext:restrict-compiler-policy 'speed 3 3) +;; (sb-ext:restrict-compiler-policy 'debug 0 0) +;; ;; (sb-ext:restrict-compiler-policy 'space 0 0) +;; (sb-ext:restrict-compiler-policy 'safety 0 0)) + + +(defparameter *readme* + (merge-pathnames "README.md" (asdf:system-source-directory :rope))) + +(defun print-time (time reps length) + (format t "rope size: ~a, ~a microseconds~%" + length + (* 1000000 (/ time reps)))) + +(defmacro time* (&body body) + `(let ((time)) + (sb-ext:call-with-timing + (lambda (&rest plist) (setf time (getf plist :real-time-ms))) + (lambda () ,@body)) + (coerce (/ time 1000) 'float))) + +(defun benchmark-insert (&optional (reps 1000000)) + (with-open-file (s *readme*) + (let* ((starting-rope (split-rope (make-rope s) 1000)) + (rope starting-rope)) + (dotimes (i 9999) + (setf rope (concat-rope rope starting-rope))) + (setf starting-rope rope) + (dotimes (i 100) + (print-time + (time* + (dotimes (i reps) + (insert-rope rope (random (rope-length rope)) "Hello, world!"))) + reps + (rope-length rope)) + (force-output) + (setf rope (concat-rope rope starting-rope)))))) diff --git a/dev/graphviz.lisp b/dev/graphviz.lisp index 7be198d..67681ab 100644 --- a/dev/graphviz.lisp +++ b/dev/graphviz.lisp @@ -3,7 +3,7 @@ (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.") (defparameter rope::*long-leaf* 24) -(defparameter rope::*short-leaf* 8) +(defparameter rope::*short-leaf* 2) (defclass root () ((name :initarg :name :accessor root-name) @@ -15,28 +15,28 @@ :attributes `(:label ,(format nil "rope: ~a~%length: ~a~%depth: ~a" (root-name root) (rope-length obj) - (rope-depth obj)) + (rope::rope-depth obj)) :style :filled)))) (defmethod graph-object-points-to ((self (eql 'rope)) (obj root)) (let ((obj (root-rope obj))) (graph-object-points-to self obj))) -(defmethod graph-object-node ((self (eql 'rope)) (obj branch)) +(defmethod graph-object-node ((self (eql 'rope)) (obj rope::branch)) (make-instance 'node :attributes `(:label ,(format nil "length: ~a~%depth: ~a" (rope-length obj) - (rope-depth obj))))) + (rope::rope-depth obj))))) -(defmethod graph-object-points-to ((self (eql 'rope)) (obj branch)) +(defmethod graph-object-points-to ((self (eql 'rope)) (obj rope::branch)) (list (make-instance 'attributed - :object (branch-right obj) + :object (rope::branch-right obj) :attributes `(:label "R")) (make-instance 'attributed - :object (branch-left obj) + :object (rope::branch-left obj) :attributes `(:label "L")))) -(defmethod graph-object-node ((self (eql 'rope)) (obj leaf)) +(defmethod graph-object-node ((self (eql 'rope)) (obj rope::leaf)) (make-instance 'node :attributes `(:label ,(format nil "~a" (rope::leaf-string obj)) @@ -75,3 +75,12 @@ (setf rope (append-rope rope " we can do it again")) (setf rope (append-rope rope " later!")) (graph-ropes (list rope))) + +#+example +(let ((rope (rope::make-rope "hello world"))) + (dotimes (i 15) + (setf rope (rope:append-rope rope "!"))) + (dotimes (i 5) + (setf rope (rope:insert-rope rope 8 "@"))) + (graph-ropes (list rope + ))) diff --git a/dev/package.lisp b/dev/package.lisp index c8bd8ea..9cbcb3e 100644 --- a/dev/package.lisp +++ b/dev/package.lisp @@ -1,4 +1,8 @@ (defpackage #:rope/dev (:use #:cl #:cl-dot #:rope) (:export - #:graph-ropes)) + ;; graphviz.lisp + #:graph-ropes + ;; benchmark.lisp + #:benchmark-insert + )) diff --git a/rope.asd b/rope.asd index 7f6100f..4f997b9 100644 --- a/rope.asd +++ b/rope.asd @@ -24,4 +24,5 @@ :depends-on (#:cl-dot #:rope) :components ((:module "dev" :components ((:file "package") - (:file "graphviz"))))) + (:file "graphviz") + (:file "benchmark"))))) diff --git a/rope.lisp b/rope.lisp index e2d1a9e..3b9a9ab 100644 --- a/rope.lisp +++ b/rope.lisp @@ -35,6 +35,18 @@ ;; Utils ;; ;;-------;; +(defun branch-weight (branch) + (rope-length (branch-left branch))) + +(defun leaf-short-p (leaf) + (>= *short-leaf* (rope-length leaf))) + +(defun strcat (a b) + (concatenate 'string a b)) + +(defun make-leaf (string &optional length) + (make-instance 'leaf :string string :length (or length (length string)))) + (defgeneric make-rope (source) (:documentation "Create a new rope from a string, stream, or pathname.") (:method ((source rope)) @@ -43,7 +55,7 @@ (labels ((read-leaves (&optional acc) (let* ((string (make-string *long-leaf*)) (length (read-sequence string source)) - (leaf (make-instance 'leaf :length length :string (subseq string 0 length)))) + (leaf (make-leaf (subseq string 0 length) length))) (if (= *long-leaf* length) (read-leaves (cons leaf acc)) (cons leaf acc))))) @@ -57,19 +69,7 @@ (if (<= *long-leaf* length) (concat-rope (make-rope (subseq source 0 (round length 2))) (make-rope (subseq source (round length 2)))) - (make-instance 'leaf :length length :string source))))) - -(defgeneric rope-weight (rope) - (:method ((rope leaf)) - (rope-length rope)) - (:method ((rope branch)) - (rope-length (branch-left rope)))) - -(defun leaf-short-p (leaf) - (>= *short-leaf* (rope-length leaf))) - -(defun strcat (a b) - (concatenate 'string a b)) + (make-leaf source length))))) ;;-----------;; ;; Iteration ;; @@ -101,6 +101,59 @@ ;; Balancing ;; ;;-----------;; +(defgeneric balance-factor (rope) + (:method ((rope leaf)) + 0) + (:method ((rope branch)) + (- (rope-depth (branch-left rope)) + (rope-depth (branch-right rope))))) + +(defun rotate-left (rope) + (with-slots (left right) rope + (concat-rope* + (concat-rope left (branch-left right)) + (branch-right right)))) + +(defun rotate-right (rope) + (with-slots (left right) rope + (concat-rope* + (branch-left left) + (concat-rope (branch-right left) right)))) + +(defun rotate-left-right (rope) + (with-slots (left right) rope + (rotate-right (concat-rope* (rotate-left left) right)))) + +(defun rotate-right-left (rope) + (with-slots (left right) rope + (rotate-left (concat-rope* left (rotate-right right))))) + +(defun balance-children (rope) + (with-slots (left right) rope + (concat-rope* (balance-rope left) + (balance-rope right)))) + +(defgeneric balance-rope (rope) + (:method ((rope leaf)) + rope) + (:method ((rope branch)) + (with-slots (left right) rope + (let ((bf (balance-factor rope))) + (cond ((< 0 bf) + (if (minusp (balance-factor left)) + (rotate-left-right rope) + (rotate-right rope))) + ((> 0 bf) + (if (plusp (balance-factor right)) + (rotate-right-left rope) + (rotate-left rope))) + (t + rope)))))) + +;;---------;; +;; Rebuild ;; +;;---------;; + (defun normalize-leaves (leaves &optional carry) (let ((leaf (car leaves))) (cond ((and carry (null leaf)) @@ -115,16 +168,6 @@ (t (cons leaf (normalize-leaves (cdr leaves))))))) -(defgeneric balancedp (rope) - (:documentation "Check if a rope is a height-balanced tree.") - (:method ((rope leaf)) - t) - (:method ((rope branch)) - (with-slots (left right) rope - (and (balancedp left) - (balancedp right) - (>= 2 (abs (- (rope-depth left) (rope-depth right)))))))) - (defun merge-leaves (leaves start end) (let ((range (- end start))) (case range @@ -134,12 +177,10 @@ (concat-rope (merge-leaves leaves start mid) (merge-leaves leaves mid end))))))) -(defun balance-rope (rope &optional forcep) +(defun rebuild-rope (rope) "Balance a rope by reconstructing it from the bottom up." - (if (and (balancedp rope) (not forcep)) - rope - (let ((leaves (normalize-leaves (collect-rope rope)))) - (merge-leaves leaves 0 (length leaves))))) + (let ((leaves (normalize-leaves (collect-rope rope)))) + (merge-leaves leaves 0 (length leaves)))) ;;--------;; ;; Insert ;; @@ -147,17 +188,17 @@ (defgeneric prepend-rope (rope source) (:documentation "Return a new rope with a string or rope inserted at the beginning of a rope.") - (:method (rope (source string)) - (concat-rope (make-rope source) rope)) (:method (rope (source rope)) - (concat-rope source rope))) + (concat-rope source rope)) + (:method (rope (source t)) + (concat-rope (make-rope source) rope))) (defgeneric append-rope (rope source) (:documentation "Return a new rope with a string or rope inserted at the end of a rope.") - (:method (rope (source string)) - (concat-rope rope (make-rope source))) (:method (rope (source rope)) - (concat-rope rope source))) + (concat-rope rope source)) + (:method (rope (source t)) + (concat-rope rope (make-rope source)))) (defun insert-rope (rope index str) "Return a new rope with a string or rope inserted at the specified index of a rope." @@ -175,7 +216,7 @@ (:method ((rope leaf) index) (char (leaf-string rope) index)) (:method ((rope branch) index) - (let ((weight (rope-weight rope))) + (let ((weight (branch-weight rope))) (if (< index weight) (index-rope (branch-left rope) index) (index-rope (branch-right rope) (- index weight)))))) @@ -192,14 +233,17 @@ ;; Concat ;; ;;--------;; +(defun concat-rope* (left right) + "Concatenates without balancing." + (make-instance 'branch + :length (+ (rope-length left) (rope-length right)) + :depth (1+ (max (rope-depth left) (rope-depth right))) + :left left + :right right)) + (defun concat-rope (left right) "Returns a balanced concatenation of two ropes." - (balance-rope - (make-instance 'branch - :length (+ (rope-length left) (rope-length right)) - :depth (1+ (max (rope-depth left) (rope-depth right))) - :left left - :right right))) + (balance-rope (concat-rope* left right))) ;;-------;; ;; Split ;; @@ -212,16 +256,16 @@ (make-rope (subseq (leaf-string rope) index)))) (:method ((rope branch) index) (with-slots (left right) rope - (let ((weight (rope-weight rope))) + (let ((weight (branch-weight rope))) (cond ((= index weight) (values left right)) ((< index weight) (multiple-value-bind (ante post) (split-rope left index) (values (balance-rope ante) - (balance-rope (concat-rope post right))))) + (concat-rope post right)))) ((> index weight) (multiple-value-bind (ante post) (split-rope right (- index weight)) - (values (balance-rope (concat-rope left ante)) + (values (concat-rope left ante) (balance-rope post))))))))) ;;------;;