diff --git a/README.md b/README.md index a413f47..4d05086 100644 --- a/README.md +++ b/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 diff --git a/dev/benchmark.lisp b/dev/benchmark.lisp index 2e6c73f..7c58ef2 100644 --- a/dev/benchmark.lisp +++ b/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)) diff --git a/dev/package.lisp b/dev/package.lisp index 9cbcb3e..57815e3 100644 --- a/dev/package.lisp +++ b/dev/package.lisp @@ -1,5 +1,7 @@ (defpackage #:rope/dev (:use #:cl #:cl-dot #:rope) + (:local-nicknames + (#:a #:alexandria)) (:export ;; graphviz.lisp #:graph-ropes diff --git a/rope.asd b/rope.asd index 4f997b9..09fc3e2 100644 --- a/rope.asd +++ b/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") diff --git a/screenshots/insert-benchmark.png b/screenshots/insert-benchmark.png new file mode 100644 index 0000000..17d5b0e Binary files /dev/null and b/screenshots/insert-benchmark.png differ diff --git a/test/fuzz.lisp b/test/fuzz.lisp index 2fbff30..e8c6fab 100644 --- a/test/fuzz.lisp +++ b/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,17 +43,19 @@ (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)) @@ -38,21 +63,38 @@ (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))))))