Remove old bdict implementation.
This commit is contained in:
parent
276e60b883
commit
2fe483c947
3 changed files with 7 additions and 472 deletions
16
src/Makefile
16
src/Makefile
|
@ -51,7 +51,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \
|
||||||
util-parser.o texts.o tests.o util-proc.o util-mail.o \
|
util-parser.o texts.o tests.o util-proc.o util-mail.o \
|
||||||
notifications.o util-format.o brmember-format.o logging.o \
|
notifications.o util-format.o brmember-format.o logging.o \
|
||||||
specification.o util-git.o cal-day.o util-stdout.o \
|
specification.o util-git.o cal-day.o util-stdout.o \
|
||||||
cal-format.o util-dict-bst.o table.o sgr-list.o sgr-block.o \
|
cal-format.o table.o sgr-list.o sgr-block.o \
|
||||||
table-processor.o table-border.o table-style.o sgr-state.o \
|
table-processor.o table-border.o table-style.o sgr-state.o \
|
||||||
util-utf8.o sgr-cell.o template-list-expander.o \
|
util-utf8.o sgr-cell.o template-list-expander.o \
|
||||||
box-drawing.o util-list.o export-web-static.o util-dir.o \
|
box-drawing.o util-list.o export-web-static.o util-dir.o \
|
||||||
|
@ -317,10 +317,10 @@ TESTS-SOURCES=tests.scm listing.import.scm util-dict-list.import.scm \
|
||||||
primes.import.scm brmember.import.scm util-csv.import.scm \
|
primes.import.scm brmember.import.scm util-csv.import.scm \
|
||||||
util-set-list.import.scm util-parser.import.scm \
|
util-set-list.import.scm util-parser.import.scm \
|
||||||
util-string.import.scm cal-day.import.scm \
|
util-string.import.scm cal-day.import.scm \
|
||||||
util-dict-bst.import.scm util-utf8.import.scm \
|
util-utf8.import.scm sgr-state.import.scm sgr-list.import.scm \
|
||||||
sgr-state.import.scm sgr-list.import.scm sgr-block.import.scm \
|
sgr-block.import.scm template-list-expander.import.scm \
|
||||||
template-list-expander.import.scm table-style.import.scm \
|
table-style.import.scm box-drawing.import.scm \
|
||||||
box-drawing.import.scm
|
util-bst.import.scm
|
||||||
|
|
||||||
tests.o: tests.import.scm
|
tests.o: tests.import.scm
|
||||||
tests.import.scm: $(TESTS-SOURCES)
|
tests.import.scm: $(TESTS-SOURCES)
|
||||||
|
@ -405,12 +405,6 @@ CAL-FORMAT-SOURCES=cal-format.scm cal-day.import.scm cal-month.import.scm
|
||||||
cal-format.o: cal-format.import.scm
|
cal-format.o: cal-format.import.scm
|
||||||
cal-format.import.scm: $(CAL-FORMAT-SOURCES)
|
cal-format.import.scm: $(CAL-FORMAT-SOURCES)
|
||||||
|
|
||||||
UTIL-DICT-BST-SOURCES=util-dict-bst.scm util-tag.import.scm \
|
|
||||||
testing.import.scm
|
|
||||||
|
|
||||||
util-dict-bst.o: util-dict-bst.import.scm
|
|
||||||
util-dict-bst.import.scm: $(UTIL-DICT-BST-SOURCES)
|
|
||||||
|
|
||||||
RACKET-KWARGS-SOURCES=racket-kwargs.scm
|
RACKET-KWARGS-SOURCES=racket-kwargs.scm
|
||||||
|
|
||||||
racket-kwargs.o: racket-kwargs.import.scm
|
racket-kwargs.o: racket-kwargs.import.scm
|
||||||
|
|
|
@ -46,7 +46,7 @@
|
||||||
util-set-list
|
util-set-list
|
||||||
util-parser
|
util-parser
|
||||||
util-string
|
util-string
|
||||||
util-dict-bst
|
util-bst
|
||||||
util-utf8
|
util-utf8
|
||||||
sgr-state
|
sgr-state
|
||||||
sgr-list
|
sgr-list
|
||||||
|
@ -59,7 +59,7 @@
|
||||||
(listing-tests!)
|
(listing-tests!)
|
||||||
(lset-tests!)
|
(lset-tests!)
|
||||||
(ldict-tests!)
|
(ldict-tests!)
|
||||||
(bdict-tests!)
|
(util-bst-tests!)
|
||||||
(cal-month-tests!)
|
(cal-month-tests!)
|
||||||
(cal-period-tests!)
|
(cal-period-tests!)
|
||||||
(cal-day-tests!)
|
(cal-day-tests!)
|
||||||
|
|
|
@ -1,459 +0,0 @@
|
||||||
;;
|
|
||||||
;; util-dict-bst.scm
|
|
||||||
;;
|
|
||||||
;; Simple dictionary implementation using BST backend. Only numbers
|
|
||||||
;; supported as keys.
|
|
||||||
;;
|
|
||||||
;; ISC License
|
|
||||||
;;
|
|
||||||
;; Copyright 2023 Brmlab, z.s.
|
|
||||||
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
|
||||||
;;
|
|
||||||
;; Permission to use, copy, modify, and/or distribute this software
|
|
||||||
;; for any purpose with or without fee is hereby granted, provided
|
|
||||||
;; that the above copyright notice and this permission notice appear
|
|
||||||
;; in all copies.
|
|
||||||
;;
|
|
||||||
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
|
||||||
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
|
||||||
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
|
||||||
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
|
||||||
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
|
|
||||||
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
|
||||||
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
|
||||||
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
||||||
;;
|
|
||||||
|
|
||||||
(declare (unit util-dict-bst))
|
|
||||||
|
|
||||||
(module
|
|
||||||
util-dict-bst
|
|
||||||
(
|
|
||||||
make-bdict
|
|
||||||
|
|
||||||
bdict?
|
|
||||||
|
|
||||||
bdict-empty?
|
|
||||||
bdict-contains?
|
|
||||||
bdict-ref
|
|
||||||
|
|
||||||
bdict-set
|
|
||||||
bdict-remove
|
|
||||||
bdict-update
|
|
||||||
|
|
||||||
bdict-find-pair
|
|
||||||
bdict-find-value
|
|
||||||
bdict-find-key
|
|
||||||
|
|
||||||
bdict-reduce
|
|
||||||
|
|
||||||
bdict-keys
|
|
||||||
bdict-values
|
|
||||||
|
|
||||||
bdict-balance
|
|
||||||
|
|
||||||
bdict-filter-pairs
|
|
||||||
bdict-filter-keys
|
|
||||||
bdict-filter-values
|
|
||||||
|
|
||||||
list->bdict
|
|
||||||
|
|
||||||
bdict-map-list
|
|
||||||
bdict-map-dict
|
|
||||||
|
|
||||||
bdict-tests!
|
|
||||||
)
|
|
||||||
(import scheme
|
|
||||||
(chicken base)
|
|
||||||
util-tag
|
|
||||||
testing)
|
|
||||||
|
|
||||||
;; Unique tag
|
|
||||||
(define TAG-BDICT (make-tag dict-bst))
|
|
||||||
|
|
||||||
;; Creates BST node with no children
|
|
||||||
(define (make-bst-node key value)
|
|
||||||
(cons (cons key value)
|
|
||||||
(cons #f #f)))
|
|
||||||
|
|
||||||
;; Read-only accessors to BST node
|
|
||||||
(define bst-node-key caar)
|
|
||||||
(define bst-node-value cdar)
|
|
||||||
(define bst-node-left cadr)
|
|
||||||
(define bst-node-right cddr)
|
|
||||||
|
|
||||||
;; Returns BST node with updated node value
|
|
||||||
(define (set-bst-node-value n v)
|
|
||||||
(cons (cons (bst-node-key n) v)
|
|
||||||
(cdr n)))
|
|
||||||
|
|
||||||
;; Updates BST node left child
|
|
||||||
(define (set-bst-node-left n l)
|
|
||||||
(cons (car n)
|
|
||||||
(cons l (bst-node-right n))))
|
|
||||||
|
|
||||||
;; Updates BST node right child
|
|
||||||
(define (set-bst-node-right n r)
|
|
||||||
(cons (car n)
|
|
||||||
(cons (bst-node-left n) r)))
|
|
||||||
|
|
||||||
;; Creates empty BST dictionary
|
|
||||||
(define (make-bdict)
|
|
||||||
(cons TAG-BDICT #f))
|
|
||||||
|
|
||||||
;; Accessor for root
|
|
||||||
(define bdict-root cdr)
|
|
||||||
|
|
||||||
;; Updates BST dictionary root node
|
|
||||||
(define (set-bdict-root d r)
|
|
||||||
(cons (car d) r))
|
|
||||||
|
|
||||||
;; Checks whether given value is BST dictionary
|
|
||||||
(define (bdict? v)
|
|
||||||
(and (pair? v)
|
|
||||||
(eq? (car v) TAG-BDICT)))
|
|
||||||
|
|
||||||
;; Returns true if given dictionary is empty
|
|
||||||
(define (bdict-empty? d)
|
|
||||||
(and (bdict? d)
|
|
||||||
(not (bdict-root d))))
|
|
||||||
|
|
||||||
;; Returns true if dictionary contains given key
|
|
||||||
(define (bdict-contains? d k)
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(let ((nk (bst-node-key n)))
|
|
||||||
(if (eq? k nk)
|
|
||||||
#t
|
|
||||||
(loop (if (< k nk)
|
|
||||||
(bst-node-left n)
|
|
||||||
(bst-node-right n)))))
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
;; Returns the value associated with given key
|
|
||||||
(define (bdict-ref d k . vs)
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(let ((nk (bst-node-key n)))
|
|
||||||
(if (eq? k nk)
|
|
||||||
(bst-node-value n)
|
|
||||||
(loop (if (< k nk)
|
|
||||||
(bst-node-left n)
|
|
||||||
(bst-node-right n)))))
|
|
||||||
(if (null? vs)
|
|
||||||
(error 'bdict-ref "Key does not exist" k)
|
|
||||||
(car vs)))))
|
|
||||||
|
|
||||||
;; Returns a dictionary with given key set to given value
|
|
||||||
(define (bdict-set d k v)
|
|
||||||
(set-bdict-root
|
|
||||||
d
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(let ((nk (bst-node-key n)))
|
|
||||||
(if (eq? k nk)
|
|
||||||
(set-bst-node-value n v)
|
|
||||||
(if (< k nk)
|
|
||||||
(set-bst-node-left n (loop (bst-node-left n)))
|
|
||||||
(set-bst-node-right n (loop (bst-node-right n))))))
|
|
||||||
(make-bst-node k v)))))
|
|
||||||
|
|
||||||
;; Functional update with optional default value (defaults to #f)
|
|
||||||
(define (bdict-update d k p . vs)
|
|
||||||
(let ((v (if (null? vs)
|
|
||||||
#f
|
|
||||||
(car vs))))
|
|
||||||
(set-bdict-root
|
|
||||||
d
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(let ((nk (bst-node-key n)))
|
|
||||||
(if (eq? k nk)
|
|
||||||
(set-bst-node-value n (p (bst-node-value n)))
|
|
||||||
(if (< k nk)
|
|
||||||
(set-bst-node-left n (loop (bst-node-left n)))
|
|
||||||
(set-bst-node-right n (loop (bst-node-right n))))))
|
|
||||||
(make-bst-node k (p v)))))))
|
|
||||||
|
|
||||||
;; Finds key-value pair based on predicate - linear search from left
|
|
||||||
;; to right
|
|
||||||
(define (bdict-find-pair d p?)
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(let ((l (loop (bst-node-left n))))
|
|
||||||
(or l
|
|
||||||
(if (p? (bst-node-key n) (bst-node-value n))
|
|
||||||
(car n)
|
|
||||||
(loop (bst-node-right n)))))
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
;; Finds value based on predicate
|
|
||||||
(define (bdict-find-value d p?)
|
|
||||||
(let ((p (bdict-find-pair d p?)))
|
|
||||||
(if p
|
|
||||||
(cdr p)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
;; Finds key based on predicate
|
|
||||||
(define (bdict-find-key d p?)
|
|
||||||
(let ((p (bdict-find-pair d p?)))
|
|
||||||
(if p
|
|
||||||
(car p)
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
;; Returns a dictionary with given key removed, if last argument is
|
|
||||||
;; #t, allows "removing" non-existent keys
|
|
||||||
(define (bdict-remove d k . nos)
|
|
||||||
(let ((new-root
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(let ((nk (bst-node-key n)))
|
|
||||||
(if (eq? nk k)
|
|
||||||
(if (bst-node-left n)
|
|
||||||
(if (bst-node-right n)
|
|
||||||
(let aloop ((an (bst-node-right n)))
|
|
||||||
(if an
|
|
||||||
(set-bst-node-left an
|
|
||||||
(aloop (bst-node-left an)))
|
|
||||||
(bst-node-left n)))
|
|
||||||
(bst-node-left n))
|
|
||||||
(if (bst-node-right n)
|
|
||||||
(bst-node-right n)
|
|
||||||
#f))
|
|
||||||
(if (< k nk)
|
|
||||||
(set-bst-node-left n (loop (bst-node-left n)))
|
|
||||||
(set-bst-node-right n (loop (bst-node-right n))))))
|
|
||||||
(if (and (not (null? nos))
|
|
||||||
(car nos))
|
|
||||||
#f
|
|
||||||
(error 'bdict-remove "Key does not exist" k))))))
|
|
||||||
(if new-root
|
|
||||||
(set-bdict-root d new-root)
|
|
||||||
d)))
|
|
||||||
|
|
||||||
;; Reduce over key-value pairs
|
|
||||||
(define (bdict-reduce init proc bd)
|
|
||||||
(let loop ((n (bdict-root bd))
|
|
||||||
(acc init))
|
|
||||||
(if n
|
|
||||||
(loop (bst-node-right n)
|
|
||||||
(proc (loop (bst-node-left n) acc)
|
|
||||||
(bst-node-key n) (bst-node-value n)))
|
|
||||||
acc)))
|
|
||||||
|
|
||||||
;; Returns all the keys contained in given dictionary
|
|
||||||
(define (bdict-keys d)
|
|
||||||
(reverse
|
|
||||||
(bdict-reduce '() (lambda (a k v) (cons k a)) d)))
|
|
||||||
|
|
||||||
;; Returns only values
|
|
||||||
(define (bdict-values d)
|
|
||||||
(reverse
|
|
||||||
(bdict-reduce '() (lambda (a k v) (cons v a)) d)))
|
|
||||||
|
|
||||||
;; Converts to vector of key-value cons cells
|
|
||||||
(define (bdict->vector d)
|
|
||||||
(apply
|
|
||||||
vector
|
|
||||||
(reverse
|
|
||||||
(bdict-reduce '() (lambda (a k v) (cons (cons k v) a)) d))))
|
|
||||||
|
|
||||||
;; Converts a vector of key-value cons cells to BST dictionary
|
|
||||||
(define (vector->bdict v)
|
|
||||||
(cons
|
|
||||||
TAG-BDICT
|
|
||||||
(let loop ((s 0)
|
|
||||||
(e (vector-length v)))
|
|
||||||
(if (= s e)
|
|
||||||
#f
|
|
||||||
(let* ((c (- e s))
|
|
||||||
(h (quotient c 2))
|
|
||||||
(m (+ s h))
|
|
||||||
(kv (vector-ref v m)))
|
|
||||||
(cons kv
|
|
||||||
(cons (loop s m)
|
|
||||||
(loop (add1 m) e))))))))
|
|
||||||
|
|
||||||
;; Returns optimally-balanced version of given dictionary
|
|
||||||
(define (bdict-balance d)
|
|
||||||
(vector->bdict
|
|
||||||
(bdict->vector d)))
|
|
||||||
|
|
||||||
;; Returns a list of key-value pairs matching predicate
|
|
||||||
(define (bdict-filter-pairs d p)
|
|
||||||
(bdict-reduce
|
|
||||||
'()
|
|
||||||
(lambda (a k v)
|
|
||||||
(let ((e (p k v)))
|
|
||||||
(if e
|
|
||||||
(cons (cons k v) a)
|
|
||||||
a)))
|
|
||||||
d))
|
|
||||||
|
|
||||||
;; Returns a list of keys pairs matching predicate
|
|
||||||
(define (bdict-filter-keys d p)
|
|
||||||
(bdict-reduce
|
|
||||||
'()
|
|
||||||
(lambda (a k v)
|
|
||||||
(let ((e (p k v)))
|
|
||||||
(if e
|
|
||||||
(cons k a)
|
|
||||||
a)))
|
|
||||||
d))
|
|
||||||
|
|
||||||
;; Returns a list of keys pairs matching predicate
|
|
||||||
(define (bdict-filter-values d p)
|
|
||||||
(bdict-reduce
|
|
||||||
'()
|
|
||||||
(lambda (a k v)
|
|
||||||
(let ((e (p k v)))
|
|
||||||
(if e
|
|
||||||
(cons v a)
|
|
||||||
a)))
|
|
||||||
d))
|
|
||||||
|
|
||||||
;; Converts list of pairs into BST dictionary
|
|
||||||
(define (list->bdict l)
|
|
||||||
(vector->bdict
|
|
||||||
(apply vector l)))
|
|
||||||
|
|
||||||
;; Returns arbitrary list created by mapping all elements
|
|
||||||
(define (bdict-map-list d p)
|
|
||||||
(reverse
|
|
||||||
(bdict-reduce
|
|
||||||
'()
|
|
||||||
(lambda (a k v)
|
|
||||||
(cons (p k v) a))
|
|
||||||
d)))
|
|
||||||
|
|
||||||
;; Returns new dictionary with all values processed (keys are left
|
|
||||||
;; intact)
|
|
||||||
(define (bdict-map-dict d p)
|
|
||||||
(set-bdict-root
|
|
||||||
d
|
|
||||||
(let loop ((n (bdict-root d)))
|
|
||||||
(if n
|
|
||||||
(cons (cons (caar n) (p (caar n) (cdar n)))
|
|
||||||
(cons (loop (cadr n))
|
|
||||||
(loop (cddr n))))
|
|
||||||
#f))))
|
|
||||||
|
|
||||||
;; Performs module self-tests
|
|
||||||
(define (bdict-tests!)
|
|
||||||
(run-tests
|
|
||||||
bdict
|
|
||||||
(test-equal? make-bdict (make-bdict) `(,TAG-BDICT . #f))
|
|
||||||
(test-true bdict-empty?
|
|
||||||
(bdict-empty? (make-bdict)))
|
|
||||||
(test-false bdict-set/bdict-empty?
|
|
||||||
(bdict-empty?
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")))
|
|
||||||
(test-true bdict-set/bdict-contains?
|
|
||||||
(bdict-contains?
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
1))
|
|
||||||
(test-false bdict-set/bdict-contains?
|
|
||||||
(bdict-contains?
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2))
|
|
||||||
(test-true bdict-set/bdict-contains?
|
|
||||||
(bdict-contains?
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2 "World")
|
|
||||||
1))
|
|
||||||
(test-equal? bdict-keys
|
|
||||||
(bdict-keys
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
23 "Hello")
|
|
||||||
666 "World")
|
|
||||||
7 "BST"))
|
|
||||||
'(7 23 666))
|
|
||||||
(test-false bdict-remove
|
|
||||||
(bdict-contains?
|
|
||||||
(bdict-remove
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
23 "Hello")
|
|
||||||
666 "World")
|
|
||||||
7 "BST")
|
|
||||||
23)
|
|
||||||
23))
|
|
||||||
(test-equal? bdict-balance
|
|
||||||
(bdict-keys
|
|
||||||
(bdict-balance
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2 "World")
|
|
||||||
3 "BST")))
|
|
||||||
'(1 2 3))
|
|
||||||
(test-equal? bdict-values
|
|
||||||
(bdict-values
|
|
||||||
(bdict-balance
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2 "World")
|
|
||||||
3 "BST")))
|
|
||||||
'("Hello" "World" "BST"))
|
|
||||||
(test-exn bdict-ref
|
|
||||||
(bdict-ref (make-bdict) 1))
|
|
||||||
(test-equal? bdict-ref
|
|
||||||
(bdict-ref
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2 "World")
|
|
||||||
3 "BST")
|
|
||||||
2)
|
|
||||||
"World")
|
|
||||||
(test-equal? bdict-update
|
|
||||||
(bdict-ref
|
|
||||||
(bdict-update
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2 "World")
|
|
||||||
3 "BST")
|
|
||||||
2
|
|
||||||
(lambda (v)
|
|
||||||
"Scheme"))
|
|
||||||
2)
|
|
||||||
"Scheme")
|
|
||||||
(test-equal? bdict-find-pair
|
|
||||||
(bdict-find-pair
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(bdict-set
|
|
||||||
(make-bdict)
|
|
||||||
1 "Hello")
|
|
||||||
2 "World")
|
|
||||||
3 "BST")
|
|
||||||
(lambda (k v)
|
|
||||||
(equal? v "World")))
|
|
||||||
(cons 2 "World"))
|
|
||||||
))
|
|
||||||
|
|
||||||
)
|
|
Loading…
Add table
Add a link
Reference in a new issue