[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 60de078: * externals-list: Convert rbit to :external
From: |
Stefan Monnier |
Subject: |
[elpa] master 60de078: * externals-list: Convert rbit to :external |
Date: |
Sat, 28 Nov 2020 18:28:56 -0500 (EST) |
branch: master
commit 60de07873dabd18c265be69d2e3091a51bc7be80
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* externals-list: Convert rbit to :external
---
externals-list | 3 +-
packages/rbit/rbit.el | 590 --------------------------------------------------
2 files changed, 2 insertions(+), 591 deletions(-)
diff --git a/externals-list b/externals-list
index d510523..d0f1cf2 100644
--- a/externals-list
+++ b/externals-list
@@ -140,6 +140,7 @@
("pspp-mode" :external nil) ;; Was
"https://git.sv.gnu.org/r/pspp.git"
("python" :core "lisp/progmodes/python.el")
;;FIXME:("org" :external ??) ;; Need to introduce snapshots!!
+ ("rbit" :external nil)
("realgud" :external "https://github.com/realgud/realgud")
("realgud-ipdb" :external "https://github.com/realgud/realgud-ipdb")
("realgud-jdb" :external "https://github.com/realgud/jdb")
@@ -150,7 +151,7 @@
("rec-mode" :external
"https://git.savannah.gnu.org/git/recutils/rec-mode.git")
("relint" :external "https://github.com/mattiase/relint")
("rich-minority" :external "https://github.com/Malabarba/rich-minority")
- ("rnc-mode" :external nil)
+ ("rnc-mode" :external nil)
("rt-liberation" :external "https://git.savannah.nongnu.org/git/rtliber")
("rudel" :external nil) ;; Was
bzr::bzr://rudel.bzr.sourceforge.net/bzrroot/rudel/trunk
("scanner" :external "https://gitlab.com/rstocker/scanner.git")
diff --git a/packages/rbit/rbit.el b/packages/rbit/rbit.el
deleted file mode 100644
index ad24210..0000000
--- a/packages/rbit/rbit.el
+++ /dev/null
@@ -1,590 +0,0 @@
-;;; rbit.el --- Red-black persistent interval trees -*- lexical-binding:t -*-
-
-;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
-
-;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords: data structures, binary tree, intervals
-;; Version: 0.1
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Self-balancing interval trees (for non-overlapping intervals, i.e.
-;; similar to Emacs's text-properties (rather than overlays), but not
-;; linked to any kind of buffer nor string).
-
-;; Following Chris Okasaki's algorithm from
-;; "Red-black trees in a functional setting", JFP'99.
-;; https://dl.acm.org/citation.cfm?id=968578.968583&coll=DL&dl=GUIDE
-
-;; The above article presents an elegant functional/persistent implementation
-;; of insertion in red-black trees. Here we have interval trees instead, so
-;; it's a bit different and we support additional operations. Those extensions
-;; aren't nearly as well thought out as Chris's algorithm, so they actually
-;; don't guarantee we preserve the 2 invariants of red-black trees :-(
-;;
-;; In practice, they should still usually give reasonably good algorithmic
-;; properties, hopefully.
-;;
-;; For reference, the invariants are:
-;; 1- a red node cannot have red children (local invariant).
-;; 2- the left and right subtrees of a node must have the same black depth
-;; (global invariant).
-;;
-;; When breaking invariants, we strive to only break invariant 1, since it can
-;; be more easily recovered later via local runtime checks, whereas detecting
-;; invariant 2 breakage requires a complete tree traversal.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'ert)
-
-(cl-defstruct (rbit-node
- (:conc-name rbit--)
- (:constructor nil)
- (:constructor rbit--node
- (black beg end val left right
- &aux
- ;; Invariant 1 occasionally broken!
- ;; (_ (cl-assert
- ;; (or black
- ;; (and (or (null left) (rbit--black left))
- ;; (or (null right) (rbit--black right))))))
- (_ (cl-assert (natnump black)))
- (_ (cl-assert (< beg end)))
- (_ (cl-assert
- (or (not (and left right))
- (= (rbit--bdepth left) (rbit--bdepth right)))))
- (_ (cl-assert (or (null left) (<= (rbit-max left) beg))))
- (_ (cl-assert (or (null right) (>= (rbit-min right) end))))))
- (:copier nil))
- black ;nil for red nodes, a natnum (the "blackness") for black nodes.
- beg end val left right)
-
-(defconst rbit-empty nil
- "An empty `rbit-tree'.")
-
-(defun rbit--get (tree x)
- (when tree
- (while
- (cond
- ((< x (rbit--beg tree)) (setq tree (rbit--left tree)))
- ((>= x (rbit--end tree)) (setq tree (rbit--right tree)))))
- tree))
-
-(defun rbit-get (tree x &optional default)
- "Return the value stored in TREE at position X.
-For an interval BEG..END we consider that it means [BEG, END[
-i.e. BEG is inside the interval, but END is not.
-If X is not inside an interval in TREE, return default."
- (let ((node (rbit--get tree x)))
- (if node (rbit--val node) default)))
-
-(defun rbit-member (tree x)
- "Return non-nil if X is within one of TREE's intervals."
- (not (not (rbit--get tree x))))
-
-(defun rbit--make-top (node)
- (when node
- (if (> (rbit--black node) 0) node (rbit--blacken node 1))))
-
-(defun rbit--blacken (node by)
- (cl-assert (>= by 0))
- (if (zerop by) node
- (when node
- (rbit--make (+ (rbit--black node) by)
- (rbit--beg node) (rbit--end node) (rbit--val node)
- (rbit--left node) (rbit--right node)))))
-
-(defun rbit--redden (node by)
- (if (zerop by) node
- (let ((nblack (- (rbit--black node) by)))
- (cl-assert (>= nblack 0))
- (rbit--node nblack
- (rbit--beg node) (rbit--end node) (rbit--val node)
- (rbit--left node) (rbit--right node)))))
-
-(defun rbit--make (black beg end val left right)
- "Make a new tree node, rebalancing locally along the way as needed."
- ;; Algorithmic properties: if left&right both have bdepth of N, then
- ;; the result has bdepth of "N + black".
- (if (zerop black)
- (or (when (and left right)
- (let ((lblack (rbit--black left))
- (rblack (rbit--black right)))
- (or (when (and (> lblack 1) (>= lblack rblack))
- (rbit--node rblack
- (rbit--beg right) (rbit--end right)
- (rbit--val right)
- (rbit--make 0 beg end val
- (rbit--redden left rblack)
- (rbit--left right))
- (rbit--right right)))
- (when (> rblack 1)
- (cl-assert (>= rblack lblack))
- (rbit--node lblack
- (rbit--beg left) (rbit--end left)
- (rbit--val left)
- (rbit--left left)
- (rbit--make 0 beg end val
- (rbit--right left)
- (rbit--redden right lblack)))))))
- (rbit--node black beg end val left right))
- (or (if (null left)
- (when (and right (> (rbit--black right) 0))
- ;; blackness is >1 to preserve bdepth. This can be used
- ;; elsewhere as a signal that this subtree is shallower
- ;; than expected (and hence needs rebalancing).
- (rbit--make (+ black (rbit--black right))
- (rbit--beg right) (rbit--end right) (rbit--val right)
- (rbit--node 0 beg end val left (rbit--left right))
- (rbit--right right)))
- (when (zerop (rbit--black left))
- (let ((ll (rbit--left left))
- (lr (rbit--right left)))
- (cond
- ((and ll (zerop (rbit--black ll)))
- (rbit--node 0
- (rbit--beg left) (rbit--end left) (rbit--val left)
- (rbit--blacken ll black)
- (rbit--node black beg end val lr right)))
- ((and lr (zerop (rbit--black lr)))
- (rbit--node
- 0 (rbit--beg lr) (rbit--end lr) (rbit--val lr)
- (rbit--node black
- (rbit--beg left) (rbit--end left) (rbit--val left)
- ll (rbit--left lr))
- (rbit--node black beg end val (rbit--right lr) right)))))))
- (if (null right)
- (when (and left (> (rbit--black left) 0))
- (rbit--make (+ black (rbit--black left))
- (rbit--beg left) (rbit--end left) (rbit--val left)
- (rbit--left left)
- (rbit--node 0 beg end val
- (rbit--right left) right)))
- (when (zerop (rbit--black right))
- (let ((rl (rbit--left right))
- (rr (rbit--right right)))
- (cond
- ((and rr (zerop (rbit--black rr)))
- (rbit--node 0 (rbit--beg right) (rbit--end right)
- (rbit--val right)
- (rbit--node black beg end val left rl)
- (rbit--blacken rr black)))
- ((and rl (zerop (rbit--black rl)))
- (rbit--node
- 0 (rbit--beg rl) (rbit--end rl) (rbit--val rl)
- (rbit--node black beg end val left (rbit--left rl))
- (rbit--node black (rbit--beg right) (rbit--end right)
- (rbit--val right)
- (rbit--right rl) rr)))))))
- (rbit--node black beg end val left right))))
-
-(defun rbit--set (tree beg end val f)
- ;; Algorithmic properties: if tree has bdepth of N, then the result should
- ;; have bdepth of N as well (potentially with 2 red nodes at the root).
- (cl-assert (< beg end))
- (if (null tree) (rbit--node 0 beg end val nil nil)
- (let ((tbeg (rbit--beg tree))
- (tend (rbit--end tree)))
- (cond
- ((<= end tbeg)
- (if (and (null f) (= end tbeg) (eql val (rbit--val tree)))
- ;; Coalesce
- (rbit--make (rbit--black tree) beg tend (rbit--val tree)
- (rbit--remove (rbit--left tree) beg end)
- (rbit--right tree))
- (rbit--make (rbit--black tree) tbeg tend (rbit--val tree)
- (rbit--set (rbit--left tree) beg end val f)
- (rbit--right tree))))
- ((<= tend beg)
- (if (and (null f) (= tend beg) (eql val (rbit--val tree)))
- ;; Coalesce
- (rbit--make (rbit--black tree) tbeg end (rbit--val tree)
- (rbit--left tree)
- (rbit--remove (rbit--right tree) beg end))
- (rbit--make (rbit--black tree) tbeg tend (rbit--val tree)
- (rbit--left tree)
- (rbit--set (rbit--right tree) beg end val f))))
- ;; beg..end intersects with the root of tree.
- (t
- ;; FIXME: Here we don't actually guarantee the result is balanced!!
- ;; More specifically `rbit--make' can handle 2 reds along "the" spine,
- ;; but here we can cause situations where 2 reds appear
- ;; on "several spines" at the same time!
- ;; Hopefully this won't be too problematic in practice!
- (let ((left (rbit--left tree))
- (right (rbit--right tree))
- (nval (if f (funcall f val (rbit--val tree)) val)))
- (if (null f)
- (progn
- ;; Coalesce the sub-intervals.
- (when (< beg tbeg)
- (setq left (rbit--remove left beg tbeg))
- (setq tbeg beg))
- (when (< tend end)
- (setq right (rbit--remove right tend end))
- (setq tend end)))
- (when (< beg tbeg)
- (setq left (rbit--set left beg tbeg val f)))
- (when (< tend end)
- (setq right (rbit--set right tend end val f))))
- (cond
- ((and (< tbeg beg) (< end tend))
- (rbit--make (rbit--black tree) beg end nval
- (rbit--set left tbeg beg (rbit--val tree) f)
- (rbit--set right end tend (rbit--val tree) f)))
- ((< tbeg beg)
- (rbit--make (rbit--black tree) beg tend nval
- (rbit--set left tbeg beg (rbit--val tree) f)
- right))
- ((< end tend)
- (rbit--make (rbit--black tree) tbeg end nval
- left
- (rbit--set right end tend (rbit--val tree) f)))
- (t
- (rbit--make (rbit--black tree) tbeg tend nval
- left right)))))))))
-
-(defun rbit-set (tree beg end val &optional f)
- "Set the value of TREE to VAL between BEG and END.
-If TREE already had values between BEG and END and F is non-nil,
-then F is called with 2 arguments (VAL and the previous value) to
-compute the resulting value."
- (rbit--make-top (rbit--set tree beg end val f)))
-
-(defun rbit-split (tree x)
- "Split TREE at X, returning a pair of trees (LEFT . RIGHT)."
- (when tree
- (cond
- ((< x (rbit--beg tree))
- (pcase-let ((`(,ll . ,lr) (rbit-split (rbit--left tree) x)))
- (cl-assert (or (null ll) (= (+ (rbit--bdepth ll) (rbit--black tree))
- (rbit--bdepth tree))))
- (cl-assert (or (null lr) (= (+ (rbit--bdepth lr) (rbit--black tree))
- (rbit--bdepth tree))))
- `(,(rbit--blacken ll (rbit--black tree))
- . ,(rbit--make (rbit--black tree)
- (rbit--beg tree) (rbit--end tree) (rbit--val tree)
- lr (rbit--right tree)))))
- ((= x (rbit--beg tree))
- `(,(rbit--blacken (rbit--left tree) (rbit--black tree))
- . ,(rbit--make (rbit--black tree)
- (rbit--beg tree) (rbit--end tree) (rbit--val tree)
- nil (rbit--right tree))))
- ((> x (rbit--end tree))
- (pcase-let ((`(,rl . ,rr) (rbit-split (rbit--right tree) x)))
- (cl-assert (or (null rl) (= (+ (rbit--bdepth rl) (rbit--black tree))
- (rbit--bdepth tree))))
- (cl-assert (or (null rr) (= (+ (rbit--bdepth rr) (rbit--black tree))
- (rbit--bdepth tree))))
- `(,(rbit--make (rbit--black tree)
- (rbit--beg tree) (rbit--end tree) (rbit--val tree)
- (rbit--left tree) rl)
- . ,(rbit--blacken rr (rbit--black tree)))))
- ((= x (rbit--end tree))
- `(,(rbit--make (rbit--black tree)
- (rbit--beg tree) (rbit--end tree) (rbit--val tree)
- (rbit--left tree) nil)
- . ,(rbit--blacken (rbit--right tree) (rbit--black tree))))
- (t
- `(,(rbit--make (rbit--black tree)
- (rbit--beg tree) x (rbit--val tree)
- (rbit--left tree) nil)
- . ,(rbit--make (rbit--black tree)
- x (rbit--end tree) (rbit--val tree)
- nil (rbit--right tree)))))))
-
-(defun rbit--lastleft (tree)
- (let ((l (rbit--left tree)))
- (if (null l)
- `((,(rbit--beg tree) ,(rbit--end tree) ,(rbit--val tree))
- . ,(rbit--blacken (rbit--right tree) (rbit--black tree)))
-
- (pcase-let ((`(,bev . ,l) (rbit--lastleft l)))
- `(,bev
- . ,(rbit--make (rbit--black tree)
- (rbit--beg tree) (rbit--end tree) (rbit--val tree)
- l (rbit--right tree)))))))
-
-(defun rbit--join2 (tree1 tree2)
- "Join disjoint trees TREE1 < TREE2."
- ;; If TREE1 and TREE2 have the same bdepth, then the result also
- ;; has that bdepth.
- (cond
- ((null tree1) tree2)
- ((null tree2) tree1)
- (t
- (cl-assert (<= (rbit-max tree1) (rbit-min tree2)))
- (cl-assert (= (rbit--bdepth tree1) (rbit--bdepth tree2)))
- (pcase-let ((`((,b ,e ,v) . ,tree2) (rbit--lastleft tree2)))
- (cl-assert (or (null tree2)
- (= (rbit--bdepth tree2) (rbit--bdepth tree1))))
- ;; FIXME: Coalesce!
- (rbit--make 0 b e v tree1 tree2)))))
-
-(defun rbit--union (tree1 tree2 f)
- ;; tree1 and tree2 should have the same bdepth and the result as well.
- (cond
- ((null tree1) tree2)
- ((null tree2) tree1)
- (t
- (cl-assert (= (rbit--bdepth tree1) (rbit--bdepth tree2)))
- (pcase-let* ((t1beg (rbit--beg tree1))
- (t1end (rbit--end tree1))
- (`(,t2l . ,t2mr) (rbit-split tree2 t1beg))
- (_ (cl-assert (or (not (and t2l t2mr))
- (= (rbit--bdepth t2l) (rbit--bdepth
t2mr)))))
- (`(,t2m . ,t2r) (rbit-split t2mr t1end))
- (_ (cl-assert (or (not (and t2m t2r))
- (= (rbit--bdepth t2m) (rbit--bdepth t2r)))))
- (tl (rbit--union
- (rbit--blacken (rbit--left tree1) (rbit--black tree1))
- t2l f))
- (tr (rbit--union
- (rbit--blacken (rbit--right tree1) (rbit--black tree1))
- t2r f))
- (tm (rbit--set t2m t1beg t1end (rbit--val tree1) f)))
- (unless t2m
- (setq tm (rbit--blacken tm (rbit--bdepth (or tl tr)))))
- (rbit--join2 (rbit--join2 tl tm) tr)))))
-
-(defun rbit-union (tree1 tree2 &optional f)
- (let ((bd1 (rbit--bdepth tree1))
- (bd2 (rbit--bdepth tree2)))
- (cond
- ((> bd1 bd2) (setq tree2 (rbit--blacken tree2 (- bd1 bd2))))
- ((> bd2 bd1) (setq tree1 (rbit--blacken tree1 (- bd2 bd1)))))
- (rbit--make-top (rbit--union tree1 tree2 f))))
-
-(defun rbit--balanced-p (tree)
- "Return black depth iff TREE obeys the red-black tree invariants."
- (if (null tree) 0
- (let ((dl (rbit--balanced-p (rbit--left tree)))
- (dr (rbit--balanced-p (rbit--right tree))))
- (cond
- ((and (numberp dl) (numberp dr))
- (if (not (= (abs dl) (abs dr)))
- 'unbalanced
- (if (zerop (rbit--black tree))
- (if (or (< dl 0) (< dr 0)) 'double-red (- dl))
- (+ (rbit--black tree) (abs dl)))))
- (t (list dl dr))))))
-
-(defun rbit--bdepth (tree)
- "Return black depth of TREE."
- (if (null tree) 0
- (+ (rbit--black tree)
- ;; Red nodes are allowed to have a nil subtree.
- (rbit--bdepth (or (rbit--left tree) (rbit--right tree))))))
-
-(defun rbit-do (f tree)
- "Call F on each interval in TREE.
-F is called with 3 args: BEG, END, and VAL. Its return value is ignored."
- (when tree
- (rbit-do f (rbit--left tree))
- (funcall f (rbit--beg tree) (rbit--end tree) (rbit--val tree))
- (rbit-do f (rbit--right tree))))
-
-(defun rbit--concat (tree1 tree2)
- "Concat two trees of the same black-depth and which do not overlap."
- ;; Algorithmic properties: if `tree1' and `tree2' both have bdepth of N, then
- ;; the result should have bdepth of N as well.
- (cond
- ((null tree1) tree2)
- ((null tree2) tree1)
- (t
- (cl-assert (<= (rbit--end tree1) (rbit--beg tree2)))
- (let ((black1 (rbit--black tree1))
- (black2 (rbit--black tree2)))
- (if (<= black1 black2)
- (rbit--make black1
- (rbit--beg tree1) (rbit--end tree1) (rbit--val tree1)
- (rbit--left tree1)
- (rbit--concat (rbit--right tree1)
- (rbit--redden tree2 black1)))
- (rbit--make black2
- (rbit--beg tree2) (rbit--end tree2) (rbit--val tree2)
- (rbit--concat (rbit--redden tree1 black2)
- (rbit--left tree2))
- (rbit--right tree2)))))))
-
-(defun rbit--remove (tree beg end)
- "Return TREE where BEG..END has been removed."
- ;; FIXME: `rbit--make' is designed to rebalance after an insertion,
- ;; not a deletion, so there's again no guarantee of balance.
- ;; Algorithmic properties: if `tree1' and `tree2' both have bdepth of N,
- ;; then the result should also have bdepth of N (unless it's nil).
- (when tree
- (let ((tbeg (rbit--beg tree))
- (tend (rbit--end tree))
- (left (rbit--left tree))
- (right (rbit--right tree)))
- (cond
- ((<= end tbeg)
- (let ((nleft (rbit--remove left beg end)))
- (rbit--make (if (or nleft right)
- (rbit--black tree)
- ;; Preserve bdepth!
- (+ (rbit--bdepth left) (rbit--black tree)))
- tbeg tend (rbit--val tree)
- nleft
- right)))
- ((<= tend beg)
- (let ((nright (rbit--remove right beg end)))
- (rbit--make (if (or left nright)
- (rbit--black tree)
- ;; Preserve bdepth!
- (+ (rbit--bdepth right) (rbit--black tree)))
- tbeg tend (rbit--val tree)
- left
- nright)))
- (t
- ;; beg..end intersects with the root of tree.
- (when (< beg tbeg)
- (setq left (rbit--remove left beg tbeg)))
- (when (< tend end)
- (setq right (rbit--remove right tend end)))
- (let ((black (rbit--black tree))
- ;; Non-nil if we lost bdepth info.
- (lost (and (not (or left right))
- (or (rbit--left tree) (rbit--right tree))))
- (res
- (cond
- ((and (< tbeg beg) (< end tend))
- (rbit--concat (rbit--set left tbeg beg (rbit--val tree) nil)
- (rbit--set right end tend (rbit--val tree)
nil)))
- ((< tbeg beg)
- (rbit--concat (rbit--set left tbeg beg (rbit--val tree) nil)
- right))
- ((< end tend)
- (rbit--concat left
- (rbit--set right end tend (rbit--val tree)
nil)))
- (t
- (rbit--concat left right)))))
- (if (and res (or (> black 0) lost))
- ;; Preserve bdepth!
- (rbit--blacken
- res (+ black (if (not lost) 0
- (rbit--bdepth (or (rbit--left tree)
- (rbit--right tree))))))
- res)))))))
-
-(defun rbit-remove (tree beg end)
- "Remove values between BEG and END from TREE."
- (rbit--make-top (rbit--remove tree beg end)))
-
-(defun rbit-clip (tree beg end)
- "Return the part of TREE included in BEG..END."
- ;; FIXME: We don't make any effort trying to return a balanced tree :-(
- (when tree
- (let ((tbeg (rbit--beg tree))
- (tend (rbit--end tree)))
- (cond
- ((<= end tbeg) (rbit-clip (rbit--left tree) beg end))
- ((<= tend beg) (rbit-clip (rbit--right tree) beg end))
- (t
- (let* ((left (rbit--left tree))
- (right (rbit--right tree))
- (nleft (if (< beg tbeg) (rbit-clip left beg end)))
- (nright (if (< tend end) (rbit-clip right beg end))))
- (if (and (<= beg tbeg) (<= tend end)
- (eq left nleft) (eq right nright))
- tree
- (rbit--make (rbit--black tree) (max beg tbeg) (min end tend)
- (rbit--val tree) nleft nright))))))))
-
-(defun rbit-map (fun tree)
- "Pass every value carried by TREE through FUN and return the resulting tree."
- (when tree
- (rbit--node (rbit--black tree) (rbit--beg tree) (rbit--end tree)
- (funcall fun (rbit--val tree))
- (rbit-map fun (rbit--left tree))
- (rbit-map fun (rbit--right tree)))))
-
-;; (defun rbit-merge (tree1 tree2 &optional fun)
-;; "Return the \"union\" of TREE1 and TREE2.
-;; The value used for those ranges covered by both trees, is that returned by
-;; FUN called with both values.
-;; If nil, FUN is taken to just return its first argument."
-;; ;; Since `tree1' and `tree2' don't necessarily have the same depth,
-;; ;; there isn't much bdepth to preserve here!
-;; (cond
-;; ((null tree1) tree2)
-;; ((null tree2) tree1)
-;; ((<= (rbit--end tree1) (rbit--beg tree2))
-;; (let* ((l1 (rbit--left tree1))
-;; (r1 (rbit--right tree1))
-;; (l2 (rbit--left tree2))
-;; (r2 (rbit--right tree2))
-
-(defun rbit-min (tree)
- "Return the smallest key of TREE, if any."
- (when tree (or (rbit-min (rbit--left tree)) (rbit--beg tree))))
-
-(defun rbit-max (tree)
- "Return the largest key of TREE, if any."
- (when tree (or (rbit-max (rbit--right tree)) (rbit--end tree))))
-
-(defun rbit-to-list (tree)
- "Return a list of intervals, by increasing order.
-Each interval is represented as (BEG END VAL)."
- (let ((res ()))
- (rbit-do (lambda (&rest args) (push args res)) tree)
- (nreverse res)))
-
-(defun rbit-from-list (intervals &optional f)
- "Construct a tree from a list of intervals.
-In case of overlap, the later intervals take precedence
-or are combined with F."
- (let ((it rbit-empty))
- (pcase-dolist (`(,beg ,end ,val) intervals)
- (setq it (rbit-set it beg end val f)))
- it))
-
-(ert-deftest rbit--test-set-1 ()
- (let ((c (lambda (x y)
- (cons x (if (listp y) y (list y))))))
- (should (equal (rbit-to-list
- (rbit-from-list '((0 5 v0-5) (1 2 v1-2) (2 4 v2-4))))
- '((0 1 v0-5) (1 2 v1-2) (2 4 v2-4) (4 5 v0-5))))
- (should (equal (rbit-to-list
- (rbit-from-list '((1 2 v1-2) (2 4 v2-4) (0 5 v0-5))))
- '((0 5 v0-5))))
- (should (equal (rbit-to-list
- (rbit-from-list '((0 5 v0-5) (1 2 v1-2) (2 4 v2-4)) c))
- '((0 1 v0-5) (1 2 (v1-2 v0-5))
- (2 4 (v2-4 v0-5)) (4 5 v0-5))))
- (should (equal (rbit-to-list
- (rbit-from-list '((1 2 v1-2) (2 4 v2-4) (0 5 v0-5)) c))
- '((0 1 v0-5) (1 2 (v0-5 v1-2))
- (2 4 (v0-5 v2-4)) (4 5 v0-5))))))
-
-(ert-deftest rbit--test-clip-1 ()
- (should (equal (rbit-to-list
- (rbit-clip
- (rbit-from-list '((0 5 v0-5) (1 2 v1-2) (2 4 v2-4)))
- 1 4))
- '((1 2 v1-2) (2 4 v2-4))))
- (should (equal (rbit-to-list
- (rbit-clip
- (rbit-from-list '((0 5 v0-5) (1 2 v1-2) (2 4 v2-4)
- (10 20 A) (12 15 B) (16 17 C)))
- 0 4))
- '((0 1 v0-5) (1 2 v1-2) (2 4 v2-4)))))
-
-(provide 'rbit)
-;;; rbit.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master 60de078: * externals-list: Convert rbit to :external,
Stefan Monnier <=