Perf

README.md

@@ -74,6 +74,13 @@ Get chars or strings at a position:
   (print (rope:substr-rope rope 10 15)))
 ```
 
+# Performance
+
+Time to insert is a good measure since it splits and concatenates.
+This graph demonstrates O(log(n)) performance:
+
+![Insert Benchmark](screenshots/insert-benchmark.png)
+
 # Dev Utils
 
 If you want to generate graphs as shown above, you will need to

dev/benchmark.lisp

@@ -6,14 +6,26 @@
 ;;   ;; (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 random-rope (total-length)
+  (with-open-file (source "/dev/urandom" :element-type '(unsigned-byte 8))
+    (labels ((read-leaves (&optional acc (acc-length 0))
+               (let* ((string* (make-array (min rope::*long-leaf* (- total-length acc-length))
+                                           :element-type '(unsigned-byte 8)))
+                      (length (read-sequence string* source))
+                      (string (map 'string #'code-char string*))
+                      (leaf (rope::make-leaf (subseq string 0 length) length)))
+                 (if (and (= rope::*long-leaf* length)
+                          (not (= total-length (+ length acc-length))))
+                     (read-leaves (cons leaf acc) (+ length acc-length))
+                     (cons leaf acc)))))
+      (let ((leaves (nreverse (read-leaves))))
+        (rope::merge-leaves leaves 0 (length leaves))))))
 
 (defun print-time (time reps length)
   (format t "rope size: ~a, ~a microseconds~%"
           length
-          (* 1000000 (/ time reps))))
+          (* 1000000 (/ time reps)))
+  (force-output))
 
 (defmacro time* (&body body)
   `(let ((time))
@@ -22,19 +34,37 @@
       (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)
+(defun benchmark-size (size step times reps)
+  (let ((rope (random-rope size))
+        (step (random-rope step)))
+    (dotimes (i times)
+      (sb-ext:gc :full t)
+      (print-time
+       (time*
+         (dotimes (i reps)
+           (insert-rope rope (random (rope-length rope)) "Hello, world!")))
+       reps
+       (rope-length rope))
+      (setf rope (concat-rope rope step)))))
+
+(defun benchmark-log (start-size limit reps)
+  (let ((rope (random-rope start-size))
+        (step (random-rope start-size)))
+    (dotimes (i limit)
+      (dotimes (i 10)
+        (unless (= i 0)
+          (setf rope (insert-rope rope
+                                  (random (rope-length rope))
+                                  step)))
+        (sb-ext:gc :full t)
         (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))))))
+         (rope-length rope)))
+      (setf step rope))))
+
+(defun benchmark-insert (&optional (reps 1000000))
+  (setf rope::*long-leaf* 512)
+  (benchmark-log 1000 6 reps))

dev/package.lisp

@@ -1,5 +1,7 @@
 (defpackage #:rope/dev
   (:use #:cl #:cl-dot #:rope)
+  (:local-nicknames
+   (#:a #:alexandria))
   (:export
    ;; graphviz.lisp
    #:graph-ropes

rope.asd

@@ -21,7 +21,7 @@
               (assert (eql t stat)))))
 
 (asdf:defsystem #:rope/dev
-  :depends-on (#:cl-dot #:rope)
+  :depends-on (#:alexandria #:cl-dot #:rope)
   :components ((:module "dev"
                 :components ((:file "package")
                              (:file "graphviz")

test/fuzz.lisp

@@ -11,6 +11,29 @@
        :length (1- length)
        :acc (rope::strcat acc (string (a:random-elt *charset*))))))
 
+(defun random-rope (total-length)
+  (with-open-file (source "/dev/urandom" :element-type '(unsigned-byte 8))
+    (labels ((read-leaves (&optional acc (acc-length 0))
+               (let* ((string* (make-array (min rope::*long-leaf* (- total-length acc-length))
+                                           :element-type '(unsigned-byte 8)))
+                      (length (read-sequence string* source))
+                      (string (map 'string #'code-char string*))
+                      (leaf (rope::make-leaf (subseq string 0 length) length)))
+                 (if (and (= rope::*long-leaf* length)
+                          (not (= total-length (+ length acc-length))))
+                     (read-leaves (cons leaf acc) (+ length acc-length))
+                     (cons leaf acc)))))
+      (let ((leaves (nreverse (read-leaves))))
+        (rope::merge-leaves leaves 0 (length leaves))))))
+
+(defgeneric balancedp (rope)
+  (:method ((rope rope::leaf))
+    t)
+  (:method ((rope rope::branch))
+    (and (>= 1 (abs (rope::balance-factor rope)))
+         (balancedp (rope::branch-left rope))
+         (balancedp (rope::branch-right rope)))))
+
 (deftest fuzz-basic-tests ()
   "Run the basic test suite with different leaf sizes."
   (loop :for i :from 1 :to 64
@@ -20,39 +43,58 @@
               (is (run-tests :rope/test/basic)))))
 
 (deftest fuzz-split ()
-  (dotimes (i 10)
+  (dotimes (i 1000)
     (let* ((length (random 10000))
            (string (random-string :length length))
            (rope (rope:make-rope string))
            (index (random length)))
       (multiple-value-bind (ante post) (rope:split-rope rope index)
+        (is (balancedp ante))
+        (is (balancedp post))
         (is (string= (subseq string 0 index) (rope:write-rope ante nil)))
         (is (string= (subseq string index) (rope:write-rope post nil)))))))
 
 (deftest fuzz-index ()
-  (dotimes (i 100)
+  (dotimes (i 1000)
     (let* ((length (1+ (random 1000)))
            (string (random-string :length length))
            (rope (rope:make-rope string))
            (index (random length)))
       (is (char= (char string index) (rope:index-rope rope index))))))
 
 (deftest fuzz-concat ()
-  (dotimes (i 100)
+  (dotimes (i 1000)
     (let* ((string-a (random-string :length (random 1000)))
            (string-b (random-string :length (random 1000)))
            (rope-a (rope:make-rope string-a))
-           (rope-b (rope:make-rope string-b)))
-      (is (string= (rope::strcat string-a string-b)
-                   (rope:write-rope (rope:concat-rope rope-a rope-b) nil))))))
+           (rope-b (rope:make-rope string-b))
+           (new-string (rope::strcat string-a string-b))
+           (new-rope (rope:concat-rope rope-a rope-b)))
+      (is (balancedp new-rope))
+      (is (string= new-string (rope:write-rope new-rope nil))))))
 
 (deftest fuzz-kill ()
-  (dotimes (i 10000)
+  (dotimes (i 1000)
     (let* ((length (+ 10 (random 1000)))
            (string (random-string :length length))
            (rope (rope:make-rope string))
            (end (1+ (random (1- length))))
-           (start (random end)))
-      (is (string= (rope::strcat (subseq string 0 start)
-                                 (subseq string end))
-                   (rope:write-rope (rope:kill-rope rope start end) nil))))))
+           (start (random end))
+           (new-string (rope::strcat (subseq string 0 start) (subseq string end)))
+           (new-rope (rope:kill-rope rope start end)))
+      (is (balancedp new-rope))
+      (is (string= new-string (rope:write-rope new-rope nil))))))
+
+#+ignore
+(deftest fuzz-insert-balance ()
+  (setf rope::*long-leaf* 128)
+  (dotimes (i 10)
+    (let ((rope (random-rope 1000)))
+      (dotimes (i 100)
+        (setf rope
+              (rope:insert-rope rope
+                                (random (rope:rope-length rope))
+                                (random-string :length (random 512))))
+        (unless (balancedp rope)
+          (return-from fuzz-insert-balance rope))
+        (is (balancedp rope))))))