From 2cb6eb58993b08694f8f5c292451d9d5c02b5648 Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sun, 8 Dec 2024 20:54:54 -0600 Subject: [PATCH 01/10] benchmark --- benchmark/insert.lisp | 39 +++++++++++++++++++++++++++++++++++++++ benchmark/package.lisp | 2 ++ rope.asd | 6 ++++++ rope.lisp | 32 ++++++++++++++++---------------- 4 files changed, 63 insertions(+), 16 deletions(-) create mode 100644 benchmark/insert.lisp create mode 100644 benchmark/package.lisp diff --git a/benchmark/insert.lisp b/benchmark/insert.lisp new file mode 100644 index 0000000..e2fc021 --- /dev/null +++ b/benchmark/insert.lisp @@ -0,0 +1,39 @@ +(in-package #:rope/benchmark) + +;; (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 (rope:split-rope (rope:make-rope s) 1000)) + (rope starting-rope)) + (dotimes (i 100) + (print-time + (time* + (dotimes (i reps) + (rope:insert-rope rope + (random (rope:rope-length rope)) + "Hello, world!"))) + reps + (rope:rope-length rope)) + (force-output) + (setf rope (rope:concat-rope rope starting-rope)))))) diff --git a/benchmark/package.lisp b/benchmark/package.lisp new file mode 100644 index 0000000..07229ff --- /dev/null +++ b/benchmark/package.lisp @@ -0,0 +1,2 @@ +(defpackage #:rope/benchmark + (:use #:cl)) diff --git a/rope.asd b/rope.asd index 7f6100f..2a3529a 100644 --- a/rope.asd +++ b/rope.asd @@ -20,6 +20,12 @@ (print result) (assert (eql t stat))))) +(asdf:defsystem #:rope/benchmark + :depends-on (#:rope) + :components ((:module "benchmark" + :components ((:file "package") + (:file "insert"))))) + (asdf:defsystem #:rope/dev :depends-on (#:cl-dot #:rope) :components ((:module "dev" diff --git a/rope.lisp b/rope.lisp index e2d1a9e..13c2747 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 ;; @@ -175,7 +175,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)))))) @@ -212,7 +212,7 @@ (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) From f67b556476fe3145aad31d9a52a290aec96a22da Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sun, 8 Dec 2024 21:01:32 -0600 Subject: [PATCH 02/10] rearrange benchmarks into dev dir --- dev/benchmark.lisp | 37 +++++++++++++++++++++++++++++++++++++ dev/graphviz.lisp | 10 +++++----- dev/package.lisp | 5 ++++- 3 files changed, 46 insertions(+), 6 deletions(-) create mode 100644 dev/benchmark.lisp diff --git a/dev/benchmark.lisp b/dev/benchmark.lisp new file mode 100644 index 0000000..5b6ec8b --- /dev/null +++ b/dev/benchmark.lisp @@ -0,0 +1,37 @@ +(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 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..ea9be26 100644 --- a/dev/graphviz.lisp +++ b/dev/graphviz.lisp @@ -22,21 +22,21 @@ (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))))) -(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)) diff --git a/dev/package.lisp b/dev/package.lisp index c8bd8ea..5f11841 100644 --- a/dev/package.lisp +++ b/dev/package.lisp @@ -1,4 +1,7 @@ (defpackage #:rope/dev (:use #:cl #:cl-dot #:rope) (:export - #:graph-ropes)) + ;; graphviz.lisp + #:graph-ropes + ;; benchmark.lisp + )) From e5f784bdf460cf6319f97ee1601f7ddbe2761a6b Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Wed, 11 Dec 2024 11:32:11 -0600 Subject: [PATCH 03/10] test --- .github/workflows/ci-test.yaml | 7 ++++-- benchmark/insert.lisp | 39 ---------------------------------- benchmark/package.lisp | 2 -- dev/package.lisp | 1 + rope.asd | 11 +++------- 5 files changed, 9 insertions(+), 51 deletions(-) delete mode 100644 benchmark/insert.lisp delete mode 100644 benchmark/package.lisp diff --git a/.github/workflows/ci-test.yaml b/.github/workflows/ci-test.yaml index efbac1d..bb606c4 100644 --- a/.github/workflows/ci-test.yaml +++ b/.github/workflows/ci-test.yaml @@ -10,12 +10,15 @@ jobs: - name: Checkout Repository uses: actions/checkout@v3 - name: Run Tests + env: + COVERALLS: 'true' + COVERALLS_REPO_TOKEN: 'COVERALLS_REPO_TOKEN=AjlQRo6hsAc6TsTv0tTXXW1AWR0MuFJQP' run: | set -ex sbcl --disable-debugger \ --load /root/quicklisp/setup.lisp \ --eval '(ql:update-all-dists)' \ --load rope.asd \ - --eval '(ql:quickload :rope/test)' \ - --eval '(asdf:test-system :rope/test)' \ + --eval '(ql:quickload :rope/test :silent t)' \ + --eval '(coveralls:with-coveralls () (asdf:test-system :rope/test))' \ --eval '(quit)' \ No newline at end of file diff --git a/benchmark/insert.lisp b/benchmark/insert.lisp deleted file mode 100644 index e2fc021..0000000 --- a/benchmark/insert.lisp +++ /dev/null @@ -1,39 +0,0 @@ -(in-package #:rope/benchmark) - -;; (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 (rope:split-rope (rope:make-rope s) 1000)) - (rope starting-rope)) - (dotimes (i 100) - (print-time - (time* - (dotimes (i reps) - (rope:insert-rope rope - (random (rope:rope-length rope)) - "Hello, world!"))) - reps - (rope:rope-length rope)) - (force-output) - (setf rope (rope:concat-rope rope starting-rope)))))) diff --git a/benchmark/package.lisp b/benchmark/package.lisp deleted file mode 100644 index 07229ff..0000000 --- a/benchmark/package.lisp +++ /dev/null @@ -1,2 +0,0 @@ -(defpackage #:rope/benchmark - (:use #:cl)) diff --git a/dev/package.lisp b/dev/package.lisp index 5f11841..9cbcb3e 100644 --- a/dev/package.lisp +++ b/dev/package.lisp @@ -4,4 +4,5 @@ ;; graphviz.lisp #:graph-ropes ;; benchmark.lisp + #:benchmark-insert )) diff --git a/rope.asd b/rope.asd index 2a3529a..8f901b9 100644 --- a/rope.asd +++ b/rope.asd @@ -7,7 +7,7 @@ :in-order-to ((test-op (test-op #:rope/test)))) (asdf:defsystem #:rope/test - :depends-on (#:alexandria #:fiasco #:rope) + :depends-on (#:alexandria #:fiasco #:cl-coveralls #:rope) :components ((:module "test" :components ((:file "basic") (:file "fuzz")))) @@ -20,14 +20,9 @@ (print result) (assert (eql t stat))))) -(asdf:defsystem #:rope/benchmark - :depends-on (#:rope) - :components ((:module "benchmark" - :components ((:file "package") - (:file "insert"))))) - (asdf:defsystem #:rope/dev :depends-on (#:cl-dot #:rope) :components ((:module "dev" :components ((:file "package") - (:file "graphviz"))))) + (:file "graphviz") + (:file "benchmark"))))) From ed4d20cb290cbc10888e1e5708568107a98a504c Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Wed, 11 Dec 2024 11:36:16 -0600 Subject: [PATCH 04/10] asdf --- .github/workflows/ci-test.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/ci-test.yaml b/.github/workflows/ci-test.yaml index bb606c4..c0143d3 100644 --- a/.github/workflows/ci-test.yaml +++ b/.github/workflows/ci-test.yaml @@ -9,6 +9,8 @@ jobs: steps: - name: Checkout Repository uses: actions/checkout@v3 + - name: Install Git + run: apt update && apt install -y git - name: Run Tests env: COVERALLS: 'true' From cba0527c15e5d0793e3a20d9ca1598a9bfee4ede Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Thu, 12 Dec 2024 23:37:49 -0600 Subject: [PATCH 05/10] rotato --- dev/benchmark.lisp | 3 ++ dev/graphviz.lisp | 13 +++-- rope.lisp | 120 ++++++++++++++++++++++++++++++++++----------- 3 files changed, 104 insertions(+), 32 deletions(-) diff --git a/dev/benchmark.lisp b/dev/benchmark.lisp index 5b6ec8b..2e6c73f 100644 --- a/dev/benchmark.lisp +++ b/dev/benchmark.lisp @@ -26,6 +26,9 @@ (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* diff --git a/dev/graphviz.lisp b/dev/graphviz.lisp index ea9be26..919a99b 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,7 +15,7 @@ :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)) @@ -26,7 +26,7 @@ (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 rope::branch)) (list (make-instance 'attributed @@ -75,3 +75,10 @@ (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 10) + (setf rope (rope:append-rope rope "!"))) + (graph-ropes (list (rope::balance-rope rope) + ))) diff --git a/rope.lisp b/rope.lisp index 13c2747..fc74f48 100644 --- a/rope.lisp +++ b/rope.lisp @@ -101,6 +101,77 @@ ;; Balancing ;; ;;-----------;; +;; Balance: -2 +;; Left Rotation +;; a c +;; / \ / \ +;; b c a e +;; / \ / \ / \ +;; d e b d f g +;; / \ +;; f g + +;; Balance: 2 +;; Right Rotation +;; a b +;; / \ / \ +;; b c d a +;; / \ / \ / \ +;; d e f g e c +;; / \ +;; f g + +(defgeneric rotate (rope direction) + (:method ((rope branch) (direction (eql :left))) + (with-slots (left right) rope + (concat-rope* + (concat-rope* left (branch-left right)) + (branch-right right)))) + (:method ((rope branch) (direction (eql :right))) + (with-slots (left right) rope + (concat-rope* + (branch-left left) + (concat-rope* (branch-right left) right))))) + +(defmethod rotate :around (rope direction) + (format t "rope: ~a, rotating: ~a~%" (write-rope rope nil) direction) + (call-next-method)) + +(defgeneric balance-direction (rope) + (:method ((rope leaf)) + nil) + (:method ((rope branch)) + (with-slots (left right) rope + (let ((balance (- (rope-depth left) (rope-depth right)))) + (cond ((< 1 balance) :right) + ((> -1 balance) :left) + (t nil)))))) + +;; (defmethod balance :around (rope) +;; (let ((bal (call-next-method))) +;; (format t "rope: ~a, balance: ~a~%" (write-rope rope nil) bal) +;; bal)) + +(defgeneric balance-rope (rope) + (:method ((rope leaf)) + rope) + (:method ((rope branch)) + (with-slots (left right) rope + (let* ((left (if (balance-direction left) (balance-rope left) left)) + (right (if (balance-direction right) (balance-rope right) right)) + (rope (concat-rope* left right)) + (balance (balance rope))) + (cond ((< 1 balance) + (rotate rope :right)) + ((> -1 balance) + (rotate rope :left)) + (t + rope)))))) + +;;---------;; +;; Rebuild ;; +;;---------;; + (defun normalize-leaves (leaves &optional carry) (let ((leaf (car leaves))) (cond ((and carry (null leaf)) @@ -115,16 +186,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 +195,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 +206,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." @@ -192,14 +251,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 ;; @@ -218,10 +280,10 @@ ((< 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))))))))) ;;------;; From bb51ece9c66b697589379fe20967a17e58601bd9 Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sat, 14 Dec 2024 22:31:11 -0600 Subject: [PATCH 06/10] fixed? --- dev/graphviz.lisp | 6 ++- rope.lisp | 111 ++++++++++++++++++++++++++++++---------------- 2 files changed, 78 insertions(+), 39 deletions(-) diff --git a/dev/graphviz.lisp b/dev/graphviz.lisp index 919a99b..ab6b91f 100644 --- a/dev/graphviz.lisp +++ b/dev/graphviz.lisp @@ -78,7 +78,9 @@ #+example (let ((rope (rope::make-rope "hello world"))) - (dotimes (i 10) + (dotimes (i 15) (setf rope (rope:append-rope rope "!"))) - (graph-ropes (list (rope::balance-rope rope) + ;; (dotimes (i 15) + ;; (setf rope (rope::balance-rope rope))) + (graph-ropes (list rope ))) diff --git a/rope.lisp b/rope.lisp index fc74f48..de3cbc8 100644 --- a/rope.lisp +++ b/rope.lisp @@ -121,52 +121,89 @@ ;; / \ ;; f g -(defgeneric rotate (rope direction) - (:method ((rope branch) (direction (eql :left))) - (with-slots (left right) rope - (concat-rope* - (concat-rope* left (branch-left right)) - (branch-right right)))) - (:method ((rope branch) (direction (eql :right))) - (with-slots (left right) rope - (concat-rope* - (branch-left left) - (concat-rope* (branch-right left) right))))) - -(defmethod rotate :around (rope direction) - (format t "rope: ~a, rotating: ~a~%" (write-rope rope nil) direction) - (call-next-method)) - -(defgeneric balance-direction (rope) +(defgeneric balance-factor (rope) (:method ((rope leaf)) - nil) + 0) (:method ((rope branch)) - (with-slots (left right) rope - (let ((balance (- (rope-depth left) (rope-depth right)))) - (cond ((< 1 balance) :right) - ((> -1 balance) :left) - (t nil)))))) - -;; (defmethod balance :around (rope) -;; (let ((bal (call-next-method))) -;; (format t "rope: ~a, balance: ~a~%" (write-rope rope nil) bal) -;; bal)) + (- (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* ((left (if (balance-direction left) (balance-rope left) left)) - (right (if (balance-direction right) (balance-rope right) right)) - (rope (concat-rope* left right)) - (balance (balance rope))) - (cond ((< 1 balance) - (rotate rope :right)) - ((> -1 balance) - (rotate rope :left)) + (let ((bf (balance-factor rope))) + (cond ((< 0 bf) + ;; (balance-children) + (if (minusp (balance-factor left)) + (rotate-left-right rope) + (rotate-right rope))) + ((> 0 bf) + ;; (balance-children) + (if (plusp (balance-factor right)) + (rotate-right-left rope) + (rotate-left rope))) (t - rope)))))) + rope)))) + ;; (with-slots (left right) rope + ;; (let ((left (if (zerop (balance-factor left)) + ;; left + ;; (balance-rope left))) + ;; (right (if (zerop (balance-factor right)) + ;; right + ;; (balance-rope right))) + ;; (rope (concat-rope* left right)) + ;; (bf (balance-factor rope))) + ;; (format t "root: ~a, left: ~a, right: ~a~%" + ;; bf + ;; (balance-factor left) + ;; (balance-factor right) + ;; ) + ;; (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)))) + ;; (with-slots (left right) rope + ;; (let* ((left (if (balance-direction left) (balance-rope left) left)) + ;; (right (if (balance-direction right) (balance-rope right) right)) + ;; (rope (concat-rope* left right)) + ;; (balance (balance rope))) + ;; (cond ((< 1 balance) (rotate rope :right)) + ;; ((> -1 balance) (rotate rope :left)) + ;; (t rope)))) + )) ;;---------;; ;; Rebuild ;; From e00692389a17d3d1daaa041411cd7b611089a056 Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sat, 14 Dec 2024 22:32:20 -0600 Subject: [PATCH 07/10] rotato --- rope.lisp | 57 +------------------------------------------------------ 1 file changed, 1 insertion(+), 56 deletions(-) diff --git a/rope.lisp b/rope.lisp index de3cbc8..3b9a9ab 100644 --- a/rope.lisp +++ b/rope.lisp @@ -101,26 +101,6 @@ ;; Balancing ;; ;;-----------;; -;; Balance: -2 -;; Left Rotation -;; a c -;; / \ / \ -;; b c a e -;; / \ / \ / \ -;; d e b d f g -;; / \ -;; f g - -;; Balance: 2 -;; Right Rotation -;; a b -;; / \ / \ -;; b c d a -;; / \ / \ / \ -;; d e f g e c -;; / \ -;; f g - (defgeneric balance-factor (rope) (:method ((rope leaf)) 0) @@ -160,50 +140,15 @@ (with-slots (left right) rope (let ((bf (balance-factor rope))) (cond ((< 0 bf) - ;; (balance-children) (if (minusp (balance-factor left)) (rotate-left-right rope) (rotate-right rope))) ((> 0 bf) - ;; (balance-children) (if (plusp (balance-factor right)) (rotate-right-left rope) (rotate-left rope))) (t - rope)))) - ;; (with-slots (left right) rope - ;; (let ((left (if (zerop (balance-factor left)) - ;; left - ;; (balance-rope left))) - ;; (right (if (zerop (balance-factor right)) - ;; right - ;; (balance-rope right))) - ;; (rope (concat-rope* left right)) - ;; (bf (balance-factor rope))) - ;; (format t "root: ~a, left: ~a, right: ~a~%" - ;; bf - ;; (balance-factor left) - ;; (balance-factor right) - ;; ) - ;; (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)))) - ;; (with-slots (left right) rope - ;; (let* ((left (if (balance-direction left) (balance-rope left) left)) - ;; (right (if (balance-direction right) (balance-rope right) right)) - ;; (rope (concat-rope* left right)) - ;; (balance (balance rope))) - ;; (cond ((< 1 balance) (rotate rope :right)) - ;; ((> -1 balance) (rotate rope :left)) - ;; (t rope)))) - )) + rope)))))) ;;---------;; ;; Rebuild ;; From aa40e44c9cdd63e7b968b6b010896b016802779d Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sat, 14 Dec 2024 22:35:16 -0600 Subject: [PATCH 08/10] fix workflow --- .github/workflows/ci-test.yaml | 11 +++-------- dev/graphviz.lisp | 4 ++-- 2 files changed, 5 insertions(+), 10 deletions(-) diff --git a/.github/workflows/ci-test.yaml b/.github/workflows/ci-test.yaml index c0143d3..4f5fe6b 100644 --- a/.github/workflows/ci-test.yaml +++ b/.github/workflows/ci-test.yaml @@ -9,18 +9,13 @@ jobs: steps: - name: Checkout Repository uses: actions/checkout@v3 - - name: Install Git - run: apt update && apt install -y git - name: Run Tests - env: - COVERALLS: 'true' - COVERALLS_REPO_TOKEN: 'COVERALLS_REPO_TOKEN=AjlQRo6hsAc6TsTv0tTXXW1AWR0MuFJQP' run: | set -ex sbcl --disable-debugger \ --load /root/quicklisp/setup.lisp \ --eval '(ql:update-all-dists)' \ --load rope.asd \ - --eval '(ql:quickload :rope/test :silent t)' \ - --eval '(coveralls:with-coveralls () (asdf:test-system :rope/test))' \ - --eval '(quit)' \ No newline at end of file + --eval '(ql:quickload :rope/test)' \ + --eval '(asdf:test-system :rope/test)' \ + --eval '(quit)'name: ci-test \ No newline at end of file diff --git a/dev/graphviz.lisp b/dev/graphviz.lisp index ab6b91f..67681ab 100644 --- a/dev/graphviz.lisp +++ b/dev/graphviz.lisp @@ -80,7 +80,7 @@ (let ((rope (rope::make-rope "hello world"))) (dotimes (i 15) (setf rope (rope:append-rope rope "!"))) - ;; (dotimes (i 15) - ;; (setf rope (rope::balance-rope rope))) + (dotimes (i 5) + (setf rope (rope:insert-rope rope 8 "@"))) (graph-ropes (list rope ))) From afa85d1da1cb816b79dafb9456d1453164cda26e Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sat, 14 Dec 2024 22:38:22 -0600 Subject: [PATCH 09/10] fix workflow --- .github/workflows/ci-test.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci-test.yaml b/.github/workflows/ci-test.yaml index 4f5fe6b..efbac1d 100644 --- a/.github/workflows/ci-test.yaml +++ b/.github/workflows/ci-test.yaml @@ -18,4 +18,4 @@ jobs: --load rope.asd \ --eval '(ql:quickload :rope/test)' \ --eval '(asdf:test-system :rope/test)' \ - --eval '(quit)'name: ci-test \ No newline at end of file + --eval '(quit)' \ No newline at end of file From 702263f7a89b89ba7f1d8dd7e0630abf1713b513 Mon Sep 17 00:00:00 2001 From: garlic0x1 Date: Sat, 14 Dec 2024 22:39:43 -0600 Subject: [PATCH 10/10] fix workflow --- rope.asd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rope.asd b/rope.asd index 8f901b9..4f997b9 100644 --- a/rope.asd +++ b/rope.asd @@ -7,7 +7,7 @@ :in-order-to ((test-op (test-op #:rope/test)))) (asdf:defsystem #:rope/test - :depends-on (#:alexandria #:fiasco #:cl-coveralls #:rope) + :depends-on (#:alexandria #:fiasco #:rope) :components ((:module "test" :components ((:file "basic") (:file "fuzz"))))