diff --git a/dev/graphviz.lisp b/dev/graphviz.lisp index 67681ab..ba399ba 100644 --- a/dev/graphviz.lisp +++ b/dev/graphviz.lisp @@ -24,9 +24,13 @@ (defmethod graph-object-node ((self (eql 'rope)) (obj rope::branch)) (make-instance 'node - :attributes `(:label ,(format nil "length: ~a~%depth: ~a" + :attributes `(:label ,(format nil "length: ~a~%bf: ~a~%depth: ~a" (rope-length obj) - (rope::rope-depth obj))))) + (rope::balance-factor obj) + (rope::rope-depth obj)) + :style ,(if (>= 1 (abs (rope::balance-factor obj))) + :solid + :filled)))) (defmethod graph-object-points-to ((self (eql 'rope)) (obj rope::branch)) (list (make-instance 'attributed diff --git a/rope.asd b/rope.asd index 09fc3e2..fc05f5b 100644 --- a/rope.asd +++ b/rope.asd @@ -9,7 +9,8 @@ (asdf:defsystem #:rope/test :depends-on (#:alexandria #:fiasco #:rope) :components ((:module "test" - :components ((:file "basic") + :components ((:file "util") + (:file "basic") (:file "fuzz")))) :perform (asdf:test-op (o c) diff --git a/rope.lisp b/rope.lisp index 3b9a9ab..29ea5b0 100644 --- a/rope.lisp +++ b/rope.lisp @@ -38,8 +38,11 @@ (defun branch-weight (branch) (rope-length (branch-left branch))) -(defun leaf-short-p (leaf) - (>= *short-leaf* (rope-length leaf))) +(defun leaf-short-p (leaf &optional other) + (>= *short-leaf* + (if other + (+ (rope-length leaf) (rope-length other)) + (rope-length leaf)))) (defun strcat (a b) (concatenate 'string a b)) @@ -128,25 +131,22 @@ (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))) + (cond ((< 1 bf) + (balance-rope + (if (minusp (balance-factor left)) + (rotate-left-right rope) + (rotate-right rope)))) + ((> -1 bf) + (balance-rope + (if (plusp (balance-factor right)) + (rotate-right-left rope) + (rotate-left rope)))) (t rope)))))) @@ -178,7 +178,9 @@ (merge-leaves leaves mid end))))))) (defun rebuild-rope (rope) - "Balance a rope by reconstructing it from the bottom up." + "Reconstruct a rope from the bottom up. +Doing this occasionally can reduce the number of leaves in a rope, +but it is expensive - O(n)." (let ((leaves (normalize-leaves (collect-rope rope)))) (merge-leaves leaves 0 (length leaves)))) @@ -188,17 +190,31 @@ (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 rope)) - (concat-rope source rope)) (:method (rope (source t)) - (concat-rope (make-rope source) rope))) + (prepend-rope rope (make-rope source))) + (:method (rope (source branch)) + (concat-rope source rope)) + (:method ((rope leaf) (source leaf)) + (if (leaf-short-p rope source) + (make-leaf (strcat (leaf-string source) (leaf-string rope))) + (concat-rope* source rope))) + (:method ((rope branch) (source leaf)) + (with-slots (left right) rope + (concat-rope* (prepend-rope left source) right)))) (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 rope)) - (concat-rope rope source)) (:method (rope (source t)) - (concat-rope rope (make-rope source)))) + (append-rope rope (make-rope source))) + (:method (rope (source branch)) + (concat-rope rope source)) + (:method ((rope leaf) (source leaf)) + (if (leaf-short-p rope source) + (make-leaf (strcat (leaf-string rope) (leaf-string source))) + (concat-rope* rope source))) + (:method ((rope branch) (source leaf)) + (with-slots (left right) rope + (concat-rope* left (append-rope right source))))) (defun insert-rope (rope index str) "Return a new rope with a string or rope inserted at the specified index of a rope." diff --git a/test/basic.lisp b/test/basic.lisp index f960bd8..c07ad86 100644 --- a/test/basic.lisp +++ b/test/basic.lisp @@ -1,4 +1,5 @@ -(fiasco:define-test-package :rope/test/basic) +(fiasco:define-test-package :rope/test/basic + (:use #:rope/test/util)) (in-package :rope/test/basic) (defparameter *string-1* @@ -19,7 +20,9 @@ can be done efficiently.") (is (= (length *string-1*) (rope:rope-length rope-1))) (is (= (length *string-2*) (rope:rope-length rope-2))) (is (string= *string-1* (rope:write-rope rope-1 nil))) - (is (string= *string-2* (rope:write-rope rope-2 nil))))) + (is (string= *string-2* (rope:write-rope rope-2 nil))) + (is (balancedp rope-1)) + (is (balancedp rope-2)))) (deftest split () "Test splitting ropes and check to ensure it is the same as splitting strings." @@ -27,7 +30,9 @@ can be done efficiently.") (let ((rope (rope:make-rope *string-2*))) (multiple-value-bind (ante post) (rope:split-rope rope i) (is (string= (subseq *string-2* 0 i) (rope:write-rope ante nil))) - (is (string= (subseq *string-2* i) (rope:write-rope post nil))))))) + (is (string= (subseq *string-2* i) (rope:write-rope post nil))) + (is (balancedp ante)) + (is (balancedp post)))))) (deftest delete-and-insert () "Make a rope, then a rope with a part deleted, then inserted." @@ -38,7 +43,10 @@ can be done efficiently.") (is (string= "Hello, rope!" (rope:write-rope rope nil))) (is (string= ", rope!" (rope:write-rope killed nil))) (is (string= "Goodbye, rope!" (rope:write-rope inserted nil))) - (is (string= "Hello, super rope!" (rope:write-rope super nil))))) + (is (string= "Hello, super rope!" (rope:write-rope super nil))) + (is (balancedp killed)) + (is (balancedp inserted)) + (is (balancedp super)))) (deftest index-rope () "Test accessing characters and strings by index" @@ -53,7 +61,9 @@ can be done efficiently.") "Test reading a file to a rope." (let* ((pathname (merge-pathnames "README.md" (asdf:system-source-directory :rope))) (rope (rope:make-rope pathname))) - (is (string= (uiop:read-file-string pathname) (rope:write-rope rope nil)))) + (is (string= (uiop:read-file-string pathname) (rope:write-rope rope nil))) + (is (balancedp rope))) (let* ((stream (make-string-input-stream *string-2*)) (rope (rope:make-rope stream))) - (is (string= *string-2* (rope:write-rope rope nil))))) + (is (string= *string-2* (rope:write-rope rope nil))) + (is (balancedp rope)))) diff --git a/test/fuzz.lisp b/test/fuzz.lisp index e8c6fab..a6e0fd1 100644 --- a/test/fuzz.lisp +++ b/test/fuzz.lisp @@ -1,39 +1,7 @@ (fiasco:define-test-package :rope/test/fuzz - (:local-nicknames (#:a #:alexandria))) + (:use #:rope/test/util)) (in-package :rope/test/fuzz) -(defvar *charset* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") - -(defun random-string (&key (length 128) (acc "")) - (if (= 0 length) - acc - (random-string - :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 @@ -85,16 +53,25 @@ (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) + (let ((rope (random-rope 10))) + (dotimes (i 1000) (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)) + (random-string :length (random 5)))) (is (balancedp rope)))))) + +;; (deftest fuzz-random-actions-balance +;; (&key (rope (random-rope (random 256))) +;; (iterations 1000)) +;; (cond ((> 50000 (rope:rope-length rope)) +;; (fuzz-random-actions-balance +;; :rope (random-insert rope) +;; :iterations (1- iterations))) +;; ((< 12 (rope:rope-length rope)) +;; (fuzz-random-actions-balance +;; :rope (random-kill rope) +;; :iterations (1- iterations))))) diff --git a/test/util.lisp b/test/util.lisp new file mode 100644 index 0000000..d55e67a --- /dev/null +++ b/test/util.lisp @@ -0,0 +1,75 @@ +(defpackage :rope/test/util + (:use #:cl) + (:local-nicknames + (#:a #:alexandria)) + (:export + #:balancedp + #:random-string + #:random-rope + #:random-path + #:random-insert + #:random-kill)) +(in-package :rope/test/util) + +(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))))) + +(defvar *charset* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") + +(defun random-string (&key (length 128) (acc "")) + (if (= 0 length) + acc + (random-string + :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)))))) + +(defmacro random-path (&body forms) + `(case (random ,(length forms)) + ,@(loop :with i := 0 + :for form :in forms + :collect (list i form) + :do (incf i)))) + +(defun random-insert (rope) + (random-path + (rope:insert-rope + rope + (random (rope:rope-length rope)) + (random-path + (random-string :length (random 1024)) + (random-rope (random 1024)))) + (rope:append-rope + rope + (random-path + (random-string :length (random 1024)) + (random-rope (random 1024)))) + (rope:prepend-rope + rope + (random-path + (random-string :length (random 1024)) + (random-rope (random 1024)))))) + +(defun random-kill (rope) + (random-path + (rope:kill-rope rope (random (rope:rope-length rope))) + ))