brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Remove old ldict implementation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-07-07 12:26:37 +02:00
parent b7aa850b94
commit 1c0e76b022
2 changed files with 0 additions and 393 deletions
Download patch file Download diff file Expand all files Collapse all files

117
doc/utils.md
View file

@ -8,123 +8,6 @@ well.
The modules are listed in alphabetical order.
### Dictionary
(import util-dict-list)
This module implements a simple key/value dictionary using lists as
backend. All operations are O(n) with respect to time.
(make-ldict [equality?/pairs [pairs]])
* ```equality?/pairs``` - procedure or list of pairs
* ```pairs``` - list of pairs
Creates a new ldict with configurable equality procedure, optionally
populating it with initial data.
If only one argument is given, the procedure checks whether it is a
list of equality procedure and acts accordingly.
(ldict? v)
* ```v``` - any value
Returns ```#t``` if given value is a ldict.
(ldict-empty? ld)
* ```ld``` - a ldict instance
Returns ```#t``` if given dictionary contains no keys.
(ldict-contains? ld k)
* ```ld``` - a ldict instance
* ```k``` - a key compatible with given ldict
Returns ```#t``` if given ```ld``` contains given key ```k```.
(ldict-ref ld k [default])
* ```ld``` - a ldict instance
* ```k``` - a compatible key
* ```default``` - optional fallback value
Retrieves the value associated with given key in given dictionary. If
the dictionary does not contain it and no default is given, an
exception is raised. Otherwise the default value is returned in case
of missing key.
(ldict-remove ld k)
* ```ld``` - a ldict instance
* ```k``` - a compatible key
Returns a new dictionary with the record under given key removed. If
the dictionary does not contain the key ```k```, an error is raised.
(ldict-set ld k v)
* ```ld``` - a ldict instance
* ```k``` - a compatible key
* ```v``` - a value to insert
Sets existing key ```k``` to the new value ```v``` or inserts it if it
is not already present in the dictionary ```ld```.
(ldict-keys ld)
* ```ld``` - a ldict instance
Returns the list of keys stored in given dictionary.
(ldict-map proc ld)
* ```proc``` - procedure accepting 1, 2 or 3 arguments
* ```ld``` - a ldict instance
Returns a new dictionary of the same type with all values processed by
given procedure.
If it accepts one argument, only the value is passed to it. If it
accepts two values, the key and the value is passed to it. And lastly
if it accepts three arguments, the key, value and numeric index
(starting from 0) are passed to it.
In all cases the value the procedure returns is taken as the new value
for given key.
(ldict-filter pred? ld)
* ```pred?``` - predicate procedure
* ```ld``` -a ldict instance
Returns a new dictionary containing only key/value pairs matching the
given predicate. The procedure ```pred?``` must accept two arguments -
the key and the value.
(ldict-reduce init proc ld)
* ```init``` - initial accumulator value
* ```proc``` - accumulating procedure
* ```ld``` - a ldict instance
Performs a reduce operation on the pairs of given dictionary using
```init``` as initial accumulator. The accumulating procedure must
accept three arguments: the value accumulated so far, the key and the
value.
(ldict-equal? d1 d2 [equality?])
* ```d1``` - a ldict instance
* ```d2``` - a ldict instance
* ```equality?``` - optional equality? predicate for values
Returns ```#t``` if both dictionaries contain the same keys and their
values are equal according to the provided ```equality?``` predicate
which defaults to ```equal?```.
### Set (List)
(import util-set-list)

276
src/util-dict-list.scm
View file

@ -1,276 +0,0 @@
;;
;; util-dict-list.scm
;;
;; Simple dictionary implementation using list backend.
;;
;; 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-list))
(module
util-dict-list
(
TAG-LDICT
make-ldict
ldict?
ldict-empty?
ldict-contains?
ldict-ref
ldict-remove
ldict-set
ldict-keys
ldict-map
ldict-filter
ldict-reduce
ldict-equal?
ldict-tests!
)
(import scheme
(chicken base)
testing
util-tag
util-proc
util-set-list)
;; Tag used for identifying list dictionaries from this module
(define TAG-LDICT (make-tag LDICT))
;; Creates an empty dictionary and optionally populates it with
;; provided pairs. Default equality is eq?, default are '().
(define (make-ldict . equality?/pairs)
(let ((equality? (if (or (null? equality?/pairs)
(not (procedure? (car equality?/pairs))))
eq?
(car equality?/pairs)))
(pairs (if (or (null? equality?/pairs)
(procedure? (car equality?/pairs)))
'()
(car equality?/pairs))))
(let loop ((ld (list TAG-LDICT
(list equality?)))
(pairs pairs))
(if (null? pairs)
ld
(loop (ldict-set ld (caar pairs) (cdar pairs))
(cdr pairs))))))
;; Returns true if given value is a ldict
(define (ldict? v)
(and (pair? v)
(eq? (car v) TAG-LDICT)))
;; Convenience accessors
(define ldict-meta cadr)
(define ldict-equality? caadr)
(define ldict-pairs cddr)
;; Returns true if given dictionary contains no keys
(define (ldict-empty? ld)
(null? (ldict-pairs ld)))
;; Checks whether given dictionary d contains the key k.
(define (ldict-contains? ld k)
(let ((equality? (ldict-equality? ld)))
(let loop ((pairs (ldict-pairs ld)))
(if (null? pairs)
#f
(if (equality? (caar pairs) k)
#t
(loop (cdr pairs)))))))
;; Retrieves the value for key k from dictionary d. If third argument
;; is provided it is used as default value in case the key does not
;; exist. If only two arguments are given and the key does not exist,
;; raises an error.
(define (ldict-ref ld k . ds)
(let ((equality? (ldict-equality? ld)))
(let loop ((pairs (ldict-pairs ld)))
(if (null? pairs)
(if (null? ds)
(error 'ldict-ref "Key does not exist" k)
(car ds))
(if (equality? (caar pairs) k)
(cdar pairs)
(loop (cdr pairs)))))))
;; Returns a new dictionary based on d with key k removed. If it
;; doesn't contain the key, an error is raised.
(define (ldict-remove ld k)
(let ((equality? (ldict-equality? ld)))
(let loop ((pairs (ldict-pairs ld))
(res '())
(failure #t))
(if (null? pairs)
(if failure
(error 'dict-remove "Key does not exist" k)
(cons TAG-LDICT
(cons (ldict-meta ld)
res)))
(loop (cdr pairs)
(if (equality? (caar pairs) k)
res
(cons (car pairs) res))
(and failure
(not (equality? (caar pairs) k))))))))
;; Adds a new value v under the key k to the dictionary d possibly
;; overwriting any value which has been stored under the key
;; before. Returns the updated dictionary.
(define (ldict-set ld k v)
(let ((equality? (ldict-equality? ld)))
(let loop ((pairs (ldict-pairs ld))
(res '()))
(if (null? pairs)
(cons TAG-LDICT
(cons (ldict-meta ld)
(cons (cons k v)
res)))
(loop (cdr pairs)
(if (equality? (caar pairs) k)
res
(cons (car pairs) res)))))))
;; Returns the list of keys stored in given dictionary.
(define (ldict-keys ld)
(map car (ldict-pairs ld)))
;; Maps dictionary values, the procedure gets key-value pairs if it
;; accepts more than one argument. If it accepts a third argument,
;; index gets passed as well.
(define (ldict-map proc ld)
(let ((both? ((procedure-arity>=? 2) proc))
(index? ((procedure-arity>=? 3) proc)))
(let loop ((pairs (ldict-pairs ld))
(res '())
(i 0))
(if (null? pairs)
(cons TAG-LDICT
(cons (ldict-meta ld)
res))
(loop (cdr pairs)
(let ((k (caar pairs))
(v (cdar pairs)))
(cons (cons k (if both?
(if index?
(proc k v i)
(proc k v))
(proc v)))
res))
(add1 i))))))
;; Returns a dictionary containing only kv pairs matching the
;; predicate which must accept two arguments. Unlike list filter,
;; does not perform final reverse on the result.
(define (ldict-filter pred? ld)
(let loop ((pairs (ldict-pairs ld))
(res '()))
(if (null? pairs)
(cons TAG-LDICT
(cons (ldict-meta ld)
res))
(loop (cdr pairs)
(if (pred? (caar pairs) (cdar pairs))
(cons (car pairs) res)
res)))))
;; Reduce over dictinary, the reducing procedure gets accumulator,
;; key and value as its three arguments.
(define (ldict-reduce init proc ld)
(let loop ((pairs (ldict-pairs ld))
(acc init))
(if (null? pairs)
acc
(loop (cdr pairs)
(proc acc (caar pairs) (cdar pairs))))))
;; Returns true if both dictionaries contain the same keys and
;; values.
(define (ldict-equal? d1 d2 . equality?)
(let ((e1 (ldict-equality? d1))
(e2 (ldict-equality? d2)))
(let ((equality? (if (null? equality?)
equal?
(car equality?))))
(if (not (eq? e1 e2))
#f
(let ((k1 (list->lset (ldict-keys d1)))
(k2 (list->lset (ldict-keys d2))))
(if (lset=? k1 k2)
(let loop ((keys (lset->list k1)))
(if (null? keys)
#t
(if (equality? (ldict-ref d1 (car keys))
(ldict-ref d2 (car keys)))
(loop (cdr keys))
#f)))
#f))))))
;; Performs self-tests of the dictionary module.
(define (ldict-tests!)
(run-tests
ldict
(test-equal? make-ldict (make-ldict) `(,TAG-LDICT (,eq?)))
(test-exn ldict-ref (ldict-ref (make-ldict) 'nonexistent))
(test-true ldict-ref (ldict-ref (make-ldict) 'nonexistent #t))
(test-equal? ldict-set (ldict-set (make-ldict) 'nonexistent 1)
`(,TAG-LDICT (,eq?) (nonexistent . 1)))
(test-equal? ldict-set (ldict-set (ldict-set (make-ldict) 'existent 1) 'existent 2)
`(,TAG-LDICT (,eq?) (existent . 2)))
(test-exn ldict-remove (ldict-remove (make-ldict) 'nonexistent))
(test-equal? ldict-remove
(ldict-remove (ldict-set (make-ldict) 'existing 1) 'existing)
(make-ldict))
(test-equal? ldict-keys (ldict-keys (ldict-set (make-ldict) 'existing 1)) '(existing))
(test-equal? ldict-map
(ldict-map (lambda (v) (* 2 v))
(make-ldict '((a . 1)
(b . 2))))
(make-ldict '((b . 4)
(a . 2))))
(test-equal? ldict-map
(ldict-map (lambda (k v) (* 2 v))
(make-ldict '((a . 1)
(b . 2))))
(make-ldict '((b . 4)
(a . 2))))
(test-equal? ldict-filter
(ldict-filter (lambda (k v)
(odd? v))
(make-ldict '((a . 1)
(b . 2))))
(make-ldict '((a . 1))))
(test-eq? ldict-reduce
(ldict-reduce 0 (lambda (a k v) (+ a v))
(make-ldict '((a . 1) (b . 2))))
3)
))
)