added data/order, docs
changed splay-tree, skip-list constructors to take orders
This commit is contained in:
Ryan Culpepper
parent
3037dea5ad
commit
0d76f8ecbf
|
|
@ -100,10 +100,10 @@
|
|||
|
||||
(define (norm s pos adjust)
|
||||
(cond [(= pos -inf.0)
|
||||
(let ([iter (splay-tree-iterate-min s)])
|
||||
(let ([iter (splay-tree-iterate-least s)])
|
||||
(and iter (splay-tree-iterate-key s iter)))]
|
||||
[(= pos +inf.0)
|
||||
(let ([iter (splay-tree-iterate-max s)])
|
||||
(let ([iter (splay-tree-iterate-greatest s)])
|
||||
;; add 1 to *include* max (recall, half-open intervals)
|
||||
(and iter (+ 1 (splay-tree-iterate-key s iter))))]
|
||||
[else pos]))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,11 @@
|
|||
racket/string
|
||||
unstable/prop-contract)
|
||||
|
||||
(define ordering/c
|
||||
(or/c '= '< '>))
|
||||
|
||||
(provide ordering/c)
|
||||
|
||||
(define-values (prop:ordered-dict ordered-dict? ordered-dict-ref)
|
||||
(make-struct-type-property 'ordered-dict #f))
|
||||
|
||||
|
|
@ -19,8 +24,8 @@
|
|||
(define prop:ordered-dict-contract
|
||||
(let ([e extreme-contract]
|
||||
[s search-contract])
|
||||
(vector-immutable/c e ;; iterate-min
|
||||
e ;; iterate-max
|
||||
(vector-immutable/c e ;; iterate-least
|
||||
e ;; iterate-greatest
|
||||
s ;; iterate-least/>?
|
||||
s ;; iterate-least/>=?
|
||||
s ;; iterate-greatest/<?
|
||||
|
|
@ -32,9 +37,9 @@
|
|||
(let ([dv d])
|
||||
((vector-ref (ordered-dict-ref dv) offset) dv arg ...)))
|
||||
|
||||
(define (dict-iterate-min d)
|
||||
(define (dict-iterate-least d)
|
||||
(appd d 0))
|
||||
(define (dict-iterate-max d)
|
||||
(define (dict-iterate-greatest d)
|
||||
(appd d 1))
|
||||
(define (dict-iterate-least/>? d k)
|
||||
(appd d 2 k))
|
||||
|
|
@ -49,8 +54,8 @@
|
|||
[prop:ordered-dict
|
||||
(struct-type-property/c prop:ordered-dict-contract)]
|
||||
[ordered-dict? (-> any/c boolean?)]
|
||||
[dict-iterate-min extreme-contract]
|
||||
[dict-iterate-max extreme-contract]
|
||||
[dict-iterate-least extreme-contract]
|
||||
[dict-iterate-greatest extreme-contract]
|
||||
[dict-iterate-least/>? search-contract]
|
||||
[dict-iterate-least/>=? search-contract]
|
||||
[dict-iterate-greatest/<? search-contract]
|
||||
|
|
@ -58,10 +63,62 @@
|
|||
|
||||
;; ============================================================
|
||||
|
||||
(provide natural-cmp
|
||||
datum-cmp)
|
||||
(struct order (name domain-contract comparator =? <?)
|
||||
#:property prop:procedure (struct-field-index comparator))
|
||||
|
||||
;; Comparator : any any -> (U '< '= '>)
|
||||
(define order*
|
||||
(let ([order
|
||||
(case-lambda
|
||||
[(name ctc cmp)
|
||||
(order name ctc cmp
|
||||
(lambda (x y) (eq? (cmp x y) '=))
|
||||
(lambda (x y) (eq? (cmp x y) '<)))]
|
||||
[(name ctc = <)
|
||||
(order name ctc
|
||||
(lambda (x y)
|
||||
(cond [(= x y) '=]
|
||||
[(< x y) '<]
|
||||
[(< y x) '>]
|
||||
[else (incomparable name x y)]))
|
||||
= <)]
|
||||
[(name ctc = < >)
|
||||
(order name ctc
|
||||
(lambda (x y)
|
||||
(cond [(= x y) '=]
|
||||
[(< x y) '<]
|
||||
[(> x y) '>]
|
||||
[else (incomparable name x y)]))
|
||||
= <)])])
|
||||
order))
|
||||
|
||||
(define (incomparable name x y)
|
||||
(error name "values are incomparable: ~e ~e" x y))
|
||||
|
||||
(provide/contract
|
||||
[rename order* order
|
||||
(->* (symbol? contract? procedure?) (procedure? procedure?)
|
||||
order?)]
|
||||
[order? (-> any/c boolean?)]
|
||||
[order-comparator
|
||||
(-> order? procedure?)]
|
||||
[order-<?
|
||||
(-> order? procedure?)]
|
||||
[order-=?
|
||||
(-> order? procedure?)]
|
||||
[order-domain-contract
|
||||
(-> order? contract?)])
|
||||
|
||||
;; ============================================================
|
||||
|
||||
(define (real/not-NaN? x) (and (real? x) (not (eqv? x +nan.0))))
|
||||
|
||||
(define real-order
|
||||
(order* 'real-order real/not-NaN? = < >))
|
||||
|
||||
(provide/contract
|
||||
[real-order order?])
|
||||
|
||||
;; ============================================================
|
||||
|
||||
#|
|
||||
natural-cmp : Comparator
|
||||
|
|
@ -103,6 +160,8 @@ Other:
|
|||
|
||||
|#
|
||||
|
||||
;; not exported because I'm not sure it's a good idea and I'm not sure
|
||||
;; how to characterize it
|
||||
(define (natural-cmp x y)
|
||||
(gen-cmp x y #t))
|
||||
|
||||
|
|
@ -239,3 +298,9 @@ Other:
|
|||
[(< i (vector-length y))
|
||||
'<]
|
||||
[else '=]))
|
||||
|
||||
(define datum-order
|
||||
(order* 'datum-order any/c datum-cmp))
|
||||
|
||||
(provide/contract
|
||||
[datum-order order?])
|
||||
|
|
@ -17,6 +17,7 @@ This manual documents data structure libraries available in the
|
|||
|
||||
@include-section["queue.scrbl"]
|
||||
@include-section["gvector.scrbl"]
|
||||
@include-section["order.scrbl"]
|
||||
@include-section["splay-tree.scrbl"]
|
||||
@include-section["skip-list.scrbl"]
|
||||
@include-section["interval-map.scrbl"]
|
||||
|
|
|
|||
201
collects/data/scribblings/order.scrbl
Normal file
201
collects/data/scribblings/order.scrbl
Normal file
|
|
@ -0,0 +1,201 @@
|
|||
#lang scribble/manual
|
||||
@(require scribble/eval
|
||||
(for-label data/order
|
||||
racket/contract
|
||||
unstable/prop-contract
|
||||
racket/dict
|
||||
racket/base))
|
||||
|
||||
@title{Orders and Ordered Dictionaries}
|
||||
|
||||
@(define the-eval (make-base-eval))
|
||||
@(the-eval '(require racket/dict data/order))
|
||||
|
||||
@defmodule[data/order]
|
||||
|
||||
@author[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
|
||||
|
||||
This library defines @deftech{orders} and the @deftech{ordered
|
||||
dictionary} generic interface.
|
||||
|
||||
@defthing[ordering/c flat-contract?]{
|
||||
|
||||
Contract for orderings, represented by the symbols @racket['=],
|
||||
@racket['<], and @racket['>].
|
||||
}
|
||||
|
||||
@defthing[prop:ordered-dict
|
||||
(struct-type-property/c
|
||||
(vector-immutableof _e/c _e/c _s/c _s/c _s/c _s/c))]{
|
||||
|
||||
Struct-type property for defining new ordered dictionary types. The
|
||||
value associated with @racket[prop:ordered-dict] should be an
|
||||
immutable vector of six procedures, two ``extrema'' procedures and
|
||||
four ``search'' procedures. The extrema procedures must satisfy
|
||||
@racket[_e/c] and the search procedures must satisfy @racket[_s/c]:
|
||||
|
||||
@racketblock[
|
||||
_e/c = (->i ([d ordered-dict?])
|
||||
[_ (d) (or/c #f (dict-iter-contract d))])
|
||||
_s/c = (->i ([d ordered-dict?]
|
||||
[k (d) (dict-key-contract d)])
|
||||
[_ (d) (or/c #f (dict-iter-contract d))])
|
||||
]
|
||||
|
||||
The procedures are implementations of the following generic functions:
|
||||
|
||||
@itemize[
|
||||
@item{@racket[dict-iterate-least]}
|
||||
@item{@racket[dict-iterate-greatest]}
|
||||
@item{@racket[dict-iterate-least/>?]}
|
||||
@item{@racket[dict-iterate-least/>=?]}
|
||||
@item{@racket[dict-iterate-greatest/<?]}
|
||||
@item{@racket[dict-iterate-greatest/<=?]}
|
||||
]
|
||||
|
||||
A struct type that implements @racket[prop:ordered-dict] must also
|
||||
implement @racket[prop:dict].
|
||||
}
|
||||
|
||||
@defproc[(ordered-dict? [x any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[x] is an instance of a struct
|
||||
implementing the @tech{ordered dictionary} interface (via
|
||||
@racket[prop:ordered-dict]).
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(dict-iterate-least [dict ordered-dict?]) any/c]
|
||||
@defproc[(dict-iterate-greatest [dict ordered-dict?]) any/c]]]{
|
||||
|
||||
Returns the position of the least (greatest) key in the ordered
|
||||
dictionary @racket[dict]. If @racket[dict] is empty, @racket[#f] is
|
||||
returned.
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(dict-iterate-least/>? [dict ordered-dict?] [key any/c]) any/c]
|
||||
@defproc[(dict-iterate-least/>=? [dict ordered-dict?] [key any/c]) any/c]
|
||||
@defproc[(dict-iterate-greatest/<? [dict ordered-dict?] [key any/c]) any/c]
|
||||
@defproc[(dict-iterate-greatest/<=? [dict ordered-dict?] [key any/c]) any/c]
|
||||
]]{
|
||||
|
||||
Returns the position of the least key greater than @racket[key], the
|
||||
least key greater than or equal to @racket[key], the greatest key less
|
||||
than @racket[key], and the greatest key less than or equal to
|
||||
@racket[key], respectively. If no key satisfies the criterion,
|
||||
@racket[#f] is returned.
|
||||
}
|
||||
|
||||
@defproc*[([(order [name symbol?]
|
||||
[domain-contract contract?]
|
||||
[comparator (-> any/c any/c ordering/c)])
|
||||
(and/c order? procedure?)]
|
||||
[(order [name symbol?]
|
||||
[domain-contract contract?]
|
||||
[=? (-> any/c any/c boolean?)]
|
||||
[<? (-> any/c any/c boolean?)]
|
||||
[>? (-> any/c any/c boolean?)
|
||||
(lambda (x y) (<? y x))])
|
||||
(and/c order? procedure?)])]{
|
||||
|
||||
Produces a named order object encapsulating a domain contract and a
|
||||
comparator function. If a single procedure is given, it is used
|
||||
directly as the comparator. If two or three procedures are given, they
|
||||
are used to construct the comparator.
|
||||
|
||||
The @racket[domain-contract] is not applied to the comparison
|
||||
function; rather, clients of the order are advised to incorporate the
|
||||
domain contracts into their own contracts. For example, when a
|
||||
splay-tree (see @racketmodname[data/splay-tree]) is constructed with
|
||||
an order, it applies the domain-contract to its keys. Thus the
|
||||
contract is checked once per dictionary procedure call, rather than on
|
||||
every comparison.
|
||||
|
||||
An order object is applicable as a procedure; it behaves as its
|
||||
comparator.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define string-order (order 'string-order string? string=? string<?))
|
||||
(string-order "abc" "acdc")
|
||||
(string-order "x" 12)
|
||||
]
|
||||
}
|
||||
|
||||
@defproc[(order? [x any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[x] is an order object, @racket[#f]
|
||||
otherwise.
|
||||
}
|
||||
|
||||
@defproc[(order-comparator [ord order?])
|
||||
(-> any/c any/c ordering/c)]{
|
||||
|
||||
Extracts the comparator function from an order object.
|
||||
}
|
||||
|
||||
@defproc[(order-domain-contract [ord order?]) contract?]{
|
||||
|
||||
Extracts the domain contract from an order object.
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(order-=? [ord order?]) (-> any/c any/c boolean?)]
|
||||
@defproc[(order-<? [ord order?]) (-> any/c any/c boolean?)]
|
||||
]]{
|
||||
|
||||
Returns a procedure representing the order's equality relation or
|
||||
less-than relation, respectively.
|
||||
}
|
||||
|
||||
@defthing[real-order order?]{
|
||||
|
||||
The order of the real numbers. The domain of @racket[real-order]
|
||||
excludes @racket[+nan.0] but includes @racket[+inf.0] and
|
||||
@racket[-inf.0]. The standard numeric comparisons (@racket[=],
|
||||
@racket[<]) are used; exact @racket[1] is equal to inexact
|
||||
@racket[1.0].
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(real-order 1.0 1)
|
||||
(real-order 5 7)
|
||||
(real-order 9.0 3.4)
|
||||
(real-order 1 +inf.0)
|
||||
(real-order 5 -inf.0)
|
||||
]
|
||||
}
|
||||
|
||||
@defthing[datum-order order?]{
|
||||
|
||||
An ad hoc order that encompasses many built-in Racket data types. The
|
||||
@racket[datum-order] comparator orders values of the same data type
|
||||
according to the data type's natural order: @racket[string=?],
|
||||
@racket[string<?] for strings, for example (but see the warning about
|
||||
numbers below). Different data types are ordered arbitrarily but
|
||||
contiguously; for example, all strings sort before all vectors, or
|
||||
vice versa. Programs should not rely on the ordering of different data
|
||||
types.
|
||||
|
||||
The order is designed so that lists, vectors, and prefab structs are
|
||||
ordered lexicographically.
|
||||
|
||||
@bold{Warning!} The @racket[datum-order] is not compatible with the
|
||||
standard numeric order; all exact numbers are ordered before all
|
||||
inexact numbers. This allows @racket[1] to be considered distinct from
|
||||
@racket[1.0], for example.
|
||||
|
||||
The following built-in data types are currently supported: numbers,
|
||||
strings, bytes, keywords, symbols, booleans, characters, null, pairs,
|
||||
vectors, boxes, and prefab structs.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(datum-order 1 2)
|
||||
(datum-order 8 5.0)
|
||||
(datum-order 3+5i 3+2i)
|
||||
(datum-order '(a #:b c) '(a #:c d c))
|
||||
(datum-order "apricot" "apple")
|
||||
(datum-order '#(1 2 3) '#(1 2))
|
||||
(datum-order '#(1 2 3) '#(1 3))
|
||||
(datum-order 'apple (box "candy"))
|
||||
]
|
||||
}
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scribble/manual
|
||||
@(require scribble/eval
|
||||
(for-label data/skip-list
|
||||
data/order
|
||||
racket/contract
|
||||
racket/dict
|
||||
racket/base))
|
||||
|
|
@ -8,8 +9,7 @@
|
|||
@title[#:tag "skip-list"]{Skip Lists}
|
||||
|
||||
@(define the-eval (make-base-eval))
|
||||
@(the-eval '(require data/skip-list))
|
||||
@(the-eval '(require racket/dict))
|
||||
@(the-eval '(require racket/dict data/order data/skip-list))
|
||||
|
||||
@defmodule[data/skip-list]
|
||||
|
||||
|
|
@ -20,21 +20,21 @@ dictionaries with totally ordered keys. They were described in the
|
|||
paper ``Skip Lists: A Probabilistic Alternative to Balanced Trees'' by
|
||||
William Pugh in Communications of the ACM, June 1990, 33(6) pp668-676.
|
||||
|
||||
A skip-list is a dictionary (@racket[dict?] from
|
||||
@racketmodname[racket/dict]). It also supports extensions of the
|
||||
dictionary interface for iterator-based search and mutation.
|
||||
A skip-list is an ordered dictionary (@racket[dict?] and
|
||||
@racket[ordered-dict?]). It also supports extensions of the dictionary
|
||||
interface for iterator-based search and mutation.
|
||||
|
||||
@defproc[(make-skip-list [=? (any/c any/c . -> . any/c)]
|
||||
[<? (any/c any/c . -> . any/c)]
|
||||
@defproc[(make-skip-list [ord order? datum-order]
|
||||
[#:key-contract key-contract contract? any/c]
|
||||
[#:value-contract value-contract contract? any/c])
|
||||
skip-list?]{
|
||||
|
||||
Makes a new empty skip-list. The skip-list uses @racket[=?] and
|
||||
@racket[<?] to order keys.
|
||||
Makes a new empty skip-list. The skip-list uses @racket[ord] to order
|
||||
keys; in addition, the domain contract of @racket[ord] is combined
|
||||
with @racket[key-contract] to check keys.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define skip-list (make-skip-list = <))
|
||||
(define skip-list (make-skip-list real-order))
|
||||
(skip-list-set! skip-list 3 'apple)
|
||||
(skip-list-set! skip-list 6 'cherry)
|
||||
(dict-map skip-list list)
|
||||
|
|
@ -136,23 +136,24 @@ keys greater than or equal to @racket[from].
|
|||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(skip-list-iterate-least/>? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
(or/c skip-list-iter? #f)]
|
||||
@defproc[(skip-list-iterate-least/>=? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
(or/c skip-list-iter? #f)]
|
||||
@defproc[(skip-list-iterate-greatest/<? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
(or/c skip-list-iter? #f)]
|
||||
@defproc[(skip-list-iterate-greatest/<=? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
(or/c skip-list-iter? #f)]
|
||||
@defproc[(skip-list-iterate-least/>? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
(or/c skip-list-iter? #f)]
|
||||
@defproc[(skip-list-iterate-least/>=? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
(or/c skip-list-iter? #f)]]]{
|
||||
]]{
|
||||
|
||||
Return the position of, respectively, the greatest key less than
|
||||
@racket[key], the greatest key less than or equal to @racket[key], the
|
||||
least key greater than @racket[key], and the least key greater than or
|
||||
equal to @racket[key].
|
||||
Implementations of @racket[dict-iterate-least],
|
||||
@racket[dict-iterate-greatest], @racket[dict-iterate-least/>?],
|
||||
@racket[dict-iterate-least/>=?], @racket[dict-iterate-greatest/<?],
|
||||
and @racket[dict-iterate-greatest/<=?], respectively.
|
||||
}
|
||||
|
||||
@defproc[(skip-list-iter? [v any/c]) boolean?]{
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scribble/manual
|
||||
@(require scribble/eval
|
||||
(for-label data/splay-tree
|
||||
data/order
|
||||
racket/contract
|
||||
racket/dict
|
||||
racket/base))
|
||||
|
|
@ -8,8 +9,7 @@
|
|||
@title{Splay Trees}
|
||||
|
||||
@(define the-eval (make-base-eval))
|
||||
@(the-eval '(require data/splay-tree))
|
||||
@(the-eval '(require racket/dict))
|
||||
@(the-eval '(require racket/dict data/order data/splay-tree))
|
||||
|
||||
@defmodule[data/splay-tree]
|
||||
|
||||
|
|
@ -20,27 +20,28 @@ with totally ordered keys. They were described in the paper
|
|||
``Self-Adjusting Binary Search Trees'' by Daniel Sleator and Robert
|
||||
Tarjan in Journal of the ACM 32(3) pp652-686.
|
||||
|
||||
A splay-tree is a dictionary (@racket[dict?] from
|
||||
@racketmodname[racket/dict]). It also supports extensions of the
|
||||
dictionary interface for iterator-based search.
|
||||
A splay-tree is a ordered dictionary (@racket[dict?] and
|
||||
@racket[ordered-dict?]).
|
||||
|
||||
@defproc[(make-splay-tree [=? (-> any/c any/c any/c)]
|
||||
[<? (-> any/c any/c any/c)]
|
||||
@defproc[(make-splay-tree [ord order? datum-order]
|
||||
[#:key-contract key-contract contract? any/c]
|
||||
[#:value-contract value-contract contract? any/c])
|
||||
splay-tree?]{
|
||||
|
||||
Makes a new empty splay-tree. The splay tree uses @racket[=?] and
|
||||
@racket[<?] to compare keys.
|
||||
Makes a new empty splay-tree. The splay tree uses @racket[ord] to
|
||||
order keys; in addition, the domain contract of @racket[ord] is
|
||||
combined with @racket[key-contract] to check keys.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define splay-tree (make-splay-tree string=? string<?))
|
||||
(define splay-tree
|
||||
(make-splay-tree (order 'string-order string? string=? string<?)))
|
||||
(splay-tree-set! splay-tree "dot" 10)
|
||||
(splay-tree-set! splay-tree "cherry" 500)
|
||||
(dict-map splay-tree list)
|
||||
(splay-tree-ref splay-tree "dot")
|
||||
(splay-tree-remove! splay-tree "cherry")
|
||||
(splay-tree-count splay-tree)
|
||||
(splay-tree-set! splay-tree 'pear 3)
|
||||
]
|
||||
}
|
||||
|
||||
|
|
@ -142,19 +143,24 @@ This operation is only allowed on adjustable splay trees, and it takes
|
|||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(splay-tree-iterate-greatest/<? [s splay-tree?] [key any/c])
|
||||
@defproc[(splay-tree-iterate-least [s splay-tree])
|
||||
(or/c #f splay-tree-iter?)]
|
||||
@defproc[(splay-tree-iterate-greatest/<=? [s splay-tree?] [key any/c])
|
||||
@defproc[(splay-tree-iterate-greatest [s splay-tree])
|
||||
(or/c #f splay-tree-iter?)]
|
||||
@defproc[(splay-tree-iterate-least/>? [s splay-tree?] [key any/c])
|
||||
(or/c #f splay-tree-iter?)]
|
||||
@defproc[(splay-tree-iterate-least/>=? [s splay-tree?] [key any/c])
|
||||
(or/c #f splay-tree-iter?)]]]{
|
||||
(or/c #f splay-tree-iter?)]
|
||||
@defproc[(splay-tree-iterate-greatest/<? [s splay-tree?] [key any/c])
|
||||
(or/c #f splay-tree-iter?)]
|
||||
@defproc[(splay-tree-iterate-greatest/<=? [s splay-tree?] [key any/c])
|
||||
(or/c #f splay-tree-iter?)]
|
||||
]]{
|
||||
|
||||
Return the position of, respectively, the greatest key less than
|
||||
@racket[key], the greatest key less than or equal to @racket[key], the
|
||||
least key greater than @racket[key], and the least key greater than or
|
||||
equal to @racket[key].
|
||||
Implementations of @racket[dict-iterate-least],
|
||||
@racket[dict-iterate-greatest], @racket[dict-iterate-least/>?],
|
||||
@racket[dict-iterate-least/>=?], @racket[dict-iterate-greatest/<?],
|
||||
and @racket[dict-iterate-greatest/<=?], respectively.
|
||||
}
|
||||
|
||||
@defproc[(splay-tree-iter? [x any/c]) boolean?]{
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require racket/match
|
||||
racket/contract
|
||||
racket/dict
|
||||
"private/ordered-dict.rkt")
|
||||
"order.rkt")
|
||||
;; owned by ryanc
|
||||
|
||||
#|
|
||||
|
|
@ -151,7 +151,7 @@ Levels are indexed starting at 1, as in the paper.
|
|||
;; t-item greatest s.t. key(t-item) <? t-key (at level)
|
||||
[t-item* (item-next t-item level)]) ;; key(t-item*) >=? t-key
|
||||
(set-item-next! f-item level t-item*)
|
||||
(delete-range f-item t-item (sub1 level) f-key t-key <?))]
|
||||
(delete-range f-item t-item (sub1 level) f-key t-key <? contract!?))]
|
||||
[else
|
||||
;; f-item is greatest s.t. key(item) <? f-key
|
||||
;; so f-item is greatest s.t. key(item) <? t-key,
|
||||
|
|
@ -315,12 +315,12 @@ Levels are indexed starting at 1, as in the paper.
|
|||
[item (item-next item 1)])
|
||||
(and item (skip-list-iter s item))))
|
||||
|
||||
(define (skip-list-iterate-min s)
|
||||
(define (skip-list-iterate-least s)
|
||||
(let* ([head (skip-list-head s)]
|
||||
[item (item-next head 1)])
|
||||
(and item (skip-list-iter s item))))
|
||||
|
||||
(define (skip-list-iterate-max s)
|
||||
(define (skip-list-iterate-greatest s)
|
||||
(let* ([head (skip-list-head s)]
|
||||
[item (closest head (item-level head)
|
||||
;; replace standard comparison with "always <",
|
||||
|
|
@ -351,8 +351,8 @@ Levels are indexed starting at 1, as in the paper.
|
|||
skip-list-iterate-value))
|
||||
|
||||
(define ordered-dict-methods
|
||||
(vector-immutable skip-list-iterate-min
|
||||
skip-list-iterate-max
|
||||
(vector-immutable skip-list-iterate-least
|
||||
skip-list-iterate-greatest
|
||||
skip-list-iterate-least/>?
|
||||
skip-list-iterate-least/>=?
|
||||
skip-list-iterate-greatest/<?
|
||||
|
|
@ -389,13 +389,17 @@ Levels are indexed starting at 1, as in the paper.
|
|||
#f))
|
||||
#:property prop:ordered-dict ordered-dict-methods)
|
||||
|
||||
(define (make-skip-list =? <?
|
||||
(define (make-skip-list [ord datum-order]
|
||||
#:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
(cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
|
||||
(skip-list (vector 'head 'head #f) 0 =? <?)]
|
||||
[else
|
||||
(skip-list* (vector 'head 'head #f) 0 =? <? key-contract value-contract)]))
|
||||
(let ([key-contract (and/c* (order-domain-contract ord) key-contract)]
|
||||
[=? (order-=? ord)]
|
||||
[<? (order-<? ord)])
|
||||
(cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
|
||||
(skip-list (vector 'head 'head #f) 0 =? <?)]
|
||||
[else
|
||||
(skip-list* (vector 'head 'head #f) 0 =? <?
|
||||
key-contract value-contract)])))
|
||||
|
||||
(define (make-adjustable-skip-list #:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
|
|
@ -405,21 +409,28 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(adjustable-skip-list* (vector 'head 'head #f) 0 = <
|
||||
key-contract value-contract)]))
|
||||
|
||||
|
||||
(define (key-c s)
|
||||
(cond [(skip-list*? s) (skip-list*-key-c s)]
|
||||
[(adjustable-skip-list*? s)
|
||||
(let ([key-c (adjustable-skip-list*-key-c s)])
|
||||
(if (eq? key-c any/c) exact-integer? (and/c exact-integer? key-c)))]
|
||||
(and/c* exact-integer? (adjustable-skip-list*-key-c s))]
|
||||
[else any/c]))
|
||||
(define (val-c s)
|
||||
(cond [(skip-list*? s) (skip-list*-value-c s)]
|
||||
[(adjustable-skip-list*? s) (adjustable-skip-list*-value-c s)]
|
||||
[else any/c]))
|
||||
|
||||
(define (and/c* x y)
|
||||
(cond [(eq? x any/c) y]
|
||||
[(eq? y any/c) x]
|
||||
[else (and/c x y)]))
|
||||
|
||||
;; ============================================================
|
||||
|
||||
(provide/contract
|
||||
[make-skip-list
|
||||
(->* ((-> any/c any/c any/c) (-> any/c any/c any/c))
|
||||
(#:key-contract contract? #:value-contract contract?)
|
||||
(->* ()
|
||||
(order? #:key-contract contract? #:value-contract contract?)
|
||||
skip-list?)]
|
||||
[make-adjustable-skip-list
|
||||
(->* ()
|
||||
|
|
@ -469,9 +480,9 @@ Levels are indexed starting at 1, as in the paper.
|
|||
[skip-list-iterate-least/>?
|
||||
(->i ([s skip-list?] [k (s) (key-c s)]) [_ (or/c skip-list-iter? #f)])]
|
||||
|
||||
[skip-list-iterate-min
|
||||
[skip-list-iterate-least
|
||||
(-> skip-list? (or/c skip-list-iter? #f))]
|
||||
[skip-list-iterate-max
|
||||
[skip-list-iterate-greatest
|
||||
(-> skip-list? (or/c skip-list-iter? #f))]
|
||||
|
||||
[skip-list-iter?
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
racket/match
|
||||
racket/dict
|
||||
racket/contract
|
||||
"private/ordered-dict.rkt")
|
||||
"order.rkt")
|
||||
|
||||
#|
|
||||
This library contains two implementations of splay trees.
|
||||
|
|
@ -473,9 +473,9 @@ Options
|
|||
(define (n:splay-tree-iterate-least/>? s key)
|
||||
(n:extreme s key '(>) n:has-next? n:find-next))
|
||||
|
||||
(define (n:splay-tree-iterate-min s)
|
||||
(define (n:splay-tree-iterate-least s)
|
||||
(n:splay-tree-iterate-first s))
|
||||
(define (n:splay-tree-iterate-max s)
|
||||
(define (n:splay-tree-iterate-greatest s)
|
||||
(match s
|
||||
[(node-splay-tree root size)
|
||||
(let-values ([(ok? root) (n:find-max root)])
|
||||
|
|
@ -515,8 +515,8 @@ Options
|
|||
n:splay-tree-iterate-value))
|
||||
|
||||
(define n:ordered-dict-methods
|
||||
(vector-immutable n:splay-tree-iterate-min
|
||||
n:splay-tree-iterate-max
|
||||
(vector-immutable n:splay-tree-iterate-least
|
||||
n:splay-tree-iterate-greatest
|
||||
n:splay-tree-iterate-least/>?
|
||||
n:splay-tree-iterate-least/>=?
|
||||
n:splay-tree-iterate-greatest/<?
|
||||
|
|
@ -744,7 +744,7 @@ Top-down splay
|
|||
(let loop ([root root])
|
||||
(let-values ([(ok? root)
|
||||
(v:extreme* mem root cmp from '(> =) v:has-next? v:find-next)])
|
||||
(if (and ok? (eq? (cmp (vnode-key mem root) '<) to))
|
||||
(if (and ok? (eq? (cmp (vnode-key mem root) to) '<))
|
||||
(loop (v:delete-root mem root cmp))
|
||||
root))))
|
||||
|
||||
|
|
@ -897,9 +897,9 @@ Top-down splay
|
|||
(define (v:splay-tree-iterate-least/>? s key)
|
||||
(v:extreme s key '(>) v:has-next? v:find-next))
|
||||
|
||||
(define (v:splay-tree-iterate-min s)
|
||||
(define (v:splay-tree-iterate-least s)
|
||||
(v:splay-tree-iterate-first s))
|
||||
(define (v:splay-tree-iterate-max s)
|
||||
(define (v:splay-tree-iterate-greatest s)
|
||||
(match s
|
||||
[(compact-splay-tree mem root cmp)
|
||||
(let-values ([(ok? root) (v:find-max mem root)])
|
||||
|
|
@ -935,8 +935,8 @@ Top-down splay
|
|||
v:splay-tree-iterate-value))
|
||||
|
||||
(define v:ordered-dict-methods
|
||||
(vector-immutable v:splay-tree-iterate-min
|
||||
v:splay-tree-iterate-max
|
||||
(vector-immutable v:splay-tree-iterate-least
|
||||
v:splay-tree-iterate-greatest
|
||||
v:splay-tree-iterate-least/>?
|
||||
v:splay-tree-iterate-least/>=?
|
||||
v:splay-tree-iterate-greatest/<?
|
||||
|
|
@ -970,26 +970,12 @@ Top-down splay
|
|||
;; Constructors, predicates
|
||||
;; ============================================================
|
||||
|
||||
(define (*make-splay-tree cmp key-contract value-contract)
|
||||
(let ([mem (make-vector (* NODE-SIZE 4) #f)])
|
||||
(set-vnode-key! mem scratch 4)
|
||||
(cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
|
||||
(compact-splay-tree mem #f cmp)]
|
||||
[else
|
||||
(compact-splay-tree* mem #f cmp key-contract value-contract)])))
|
||||
|
||||
(define (make-splay-tree =? <?
|
||||
(define (make-splay-tree [ord datum-order]
|
||||
#:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
(*make-splay-tree (mkcmp <? =?) key-contract value-contract))
|
||||
|
||||
(define (make-natural-splay-tree #:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
(*make-splay-tree natural-cmp key-contract value-contract))
|
||||
|
||||
(define (make-datum-splay-tree #:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
(*make-splay-tree natural-cmp key-contract value-contract))
|
||||
(*make-splay-tree (order-comparator ord)
|
||||
(and/c* (order-domain-contract ord) key-contract)
|
||||
value-contract))
|
||||
|
||||
(define (make-adjustable-splay-tree #:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
|
|
@ -998,13 +984,24 @@ Top-down splay
|
|||
[else
|
||||
(node-splay-tree* #f 0 key-contract value-contract)]))
|
||||
|
||||
(define (*make-splay-tree cmp key-contract value-contract)
|
||||
(let ([mem (make-vector (* NODE-SIZE 4) #f)])
|
||||
(set-vnode-key! mem scratch 4)
|
||||
(cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
|
||||
(compact-splay-tree mem #f cmp)]
|
||||
[else
|
||||
(compact-splay-tree* mem #f cmp key-contract value-contract)])))
|
||||
|
||||
(define (splay-tree? x)
|
||||
(or (node-splay-tree? x) (compact-splay-tree? x)))
|
||||
|
||||
(define (adjustable-splay-tree? s)
|
||||
(node-splay-tree? s))
|
||||
|
||||
|
||||
(define (and/c* x y)
|
||||
(cond [(eq? x any/c) y]
|
||||
[(eq? y any/c) x]
|
||||
[else (and/c x y)]))
|
||||
|
||||
;; ============================================================
|
||||
;; Splay trees
|
||||
|
|
@ -1041,8 +1038,8 @@ Top-down splay
|
|||
(splay-tree-iterate-greatest/<? s key)
|
||||
(splay-tree-iterate-least/>=? s key)
|
||||
(splay-tree-iterate-least/>? s key)
|
||||
(splay-tree-iterate-min s)
|
||||
(splay-tree-iterate-max s)
|
||||
(splay-tree-iterate-least s)
|
||||
(splay-tree-iterate-greatest s)
|
||||
(splay-tree->list s))
|
||||
|
||||
|
||||
|
|
@ -1053,8 +1050,7 @@ Top-down splay
|
|||
(define (key-c s)
|
||||
(cond [(compact-splay-tree*? s) (compact-splay-tree*-key-c s)]
|
||||
[(node-splay-tree*? s)
|
||||
(let ([c (node-splay-tree*-key-c s)])
|
||||
(if (eq? c any/c) exact-integer? (and/c exact-integer? c)))]
|
||||
(and/c* exact-integer? (node-splay-tree*-key-c s))]
|
||||
[(node-splay-tree? s) exact-integer?]
|
||||
[else any/c]))
|
||||
(define (val-c s)
|
||||
|
|
@ -1064,8 +1060,8 @@ Top-down splay
|
|||
|
||||
(provide/contract
|
||||
[make-splay-tree
|
||||
(->* ((-> any/c any/c any) (-> any/c any/c any))
|
||||
(#:key-contract contract? #:value-contract contract?)
|
||||
(->* ()
|
||||
(order? #:key-contract contract? #:value-contract contract?)
|
||||
splay-tree?)]
|
||||
[make-adjustable-splay-tree
|
||||
(->* ()
|
||||
|
|
@ -1123,9 +1119,9 @@ Top-down splay
|
|||
[splay-tree-iterate-least/>?
|
||||
(->i ([s splay-tree?] [k (s) (key-c s)]) [_ (or/c splay-tree-iter? #f)])]
|
||||
|
||||
[splay-tree-iterate-min
|
||||
[splay-tree-iterate-least
|
||||
(-> splay-tree? (or/c splay-tree-iter? #f))]
|
||||
[splay-tree-iterate-max
|
||||
[splay-tree-iterate-greatest
|
||||
(-> splay-tree? (or/c splay-tree-iter? #f))]
|
||||
|
||||
[splay-tree-iter? (-> any/c boolean?)])
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
#lang racket/base
|
||||
(require rackunit
|
||||
racket/contract
|
||||
racket/dict
|
||||
data/skip-list
|
||||
data/splay-tree
|
||||
data/private/ordered-dict)
|
||||
data/order)
|
||||
|
||||
;; Tests for ordered dictionaries
|
||||
;; - skip-list
|
||||
|
|
@ -92,10 +93,17 @@
|
|||
dict-iterate-greatest/<?
|
||||
dict-iterate-greatest/<=?)))
|
||||
|
||||
(test-case "skip-list, dict interface"
|
||||
(dict-test (list (make-skip-list = <)) #t #t))
|
||||
(test-case "splay-tree, dict interface"
|
||||
(dict-test (list (make-splay-tree = <)) #t #t))
|
||||
(test-case "skip-list, datum-order, dict interface"
|
||||
(dict-test (list (make-skip-list)) #t #t))
|
||||
(test-case "skip-list, < = order, dict interface"
|
||||
(dict-test (list (make-skip-list (order 'my-order any/c = <))) #t #t))
|
||||
(test-case "adjustable-skip-list, dict interface"
|
||||
(dict-test (list (make-adjustable-skip-list)) #t #t))
|
||||
|
||||
(test-case "splay-tree, datum-order, dict interface"
|
||||
(dict-test (list (make-splay-tree)) #t #t))
|
||||
(test-case "splay-tree, < = order, dict interface"
|
||||
(dict-test (list (make-splay-tree (order 'mine any/c = <))) #t #t))
|
||||
(test-case "adjustable-splay-tree, dict interface"
|
||||
(dict-test (list (make-adjustable-splay-tree)) #t #t))
|
||||
|
||||
|
|
@ -116,10 +124,12 @@
|
|||
splay-tree-iterate-greatest/<?
|
||||
splay-tree-iterate-greatest/<=?)))
|
||||
|
||||
(test-case "splay-tree, splay-tree interface"
|
||||
(splay-test (list (make-splay-tree = <)) #t #t))
|
||||
(test-case "splay-tree, datum-order, custom interface"
|
||||
(splay-test (list (make-splay-tree)) #t #t))
|
||||
(test-case "splay-tree, < = order, custom interface"
|
||||
(splay-test (list (make-splay-tree (order 'mine any/c = <))) #t #t))
|
||||
|
||||
(test-case "adjustable-splay-tree, splay-tree interface"
|
||||
(test-case "adjustable-splay-tree, custom interface"
|
||||
(splay-test (list (make-adjustable-splay-tree)) #t #t))
|
||||
|
||||
(provide splay-test)
|
||||
|
|
@ -139,8 +149,14 @@
|
|||
skip-list-iterate-greatest/<?
|
||||
skip-list-iterate-greatest/<=?)))
|
||||
|
||||
(test-case "skip-list, skip-list interface"
|
||||
(skip-test (list (make-skip-list = <)) #t #t))
|
||||
(test-case "skip-list, datum-order, custom interface"
|
||||
(skip-test (list (make-skip-list)) #t #t))
|
||||
|
||||
(test-case "skip-list, < = order, custom interface"
|
||||
(skip-test (list (make-skip-list (order 'mine any/c = <))) #t #t))
|
||||
|
||||
(test-case "adjustable-skip-list, custom interface"
|
||||
(skip-test (list (make-adjustable-skip-list)) #t #t))
|
||||
|
||||
(provide skip-test)
|
||||
|
||||
|
|
@ -169,6 +185,8 @@
|
|||
;; ============================================================
|
||||
|
||||
(define (p name testf mkd ordered?)
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(let-values ([(_result cpu real gc)
|
||||
(time-apply
|
||||
(lambda ()
|
||||
|
|
@ -177,18 +195,16 @@
|
|||
null)])
|
||||
(printf "~a : ~s\n" name cpu)))
|
||||
|
||||
(define (mksplay) (make-splay-tree = <))
|
||||
(define (mksplay) (make-splay-tree))
|
||||
(define (mkadj) (make-adjustable-splay-tree))
|
||||
(define (mkcsplay) (make-splay-tree = < #:key-contract number? #:value-contract number?))
|
||||
(define (mkdsplay) (make-datum-splay-tree))
|
||||
(define (mkskip) (make-skip-list = <))
|
||||
(define (mkcskip) (make-skip-list = < #:key-contract number? #:value-contract number?))
|
||||
(define (mkcsplay) (make-splay-tree real-order))
|
||||
(define (mkskip) (make-skip-list))
|
||||
(define (mkcskip) (make-skip-list real-order))
|
||||
|
||||
(define (performance)
|
||||
(display "Using ordered-dict interface, w/ search\n")
|
||||
(p "splay-tree" dict-test mksplay #t)
|
||||
(p "adj splay " dict-test mkadj #t)
|
||||
(p "dat splay " dict-test mkdsplay #t)
|
||||
(p "skip-list " dict-test mkskip #t)
|
||||
(p "splay w/ c" dict-test mkcsplay #t)
|
||||
(p "skip w/ c " dict-test mkcskip #t)
|
||||
|
|
@ -196,7 +212,6 @@
|
|||
(display "Using custom interfaces, w/ search\n")
|
||||
(p "splay-tree" splay-test mksplay #t)
|
||||
(p "adj splay " splay-test mkadj #t)
|
||||
(p "dat splay " splay-test mkdsplay #t)
|
||||
(p "skip-list " skip-test mkskip #t)
|
||||
(p "splay w/ c" splay-test mkcsplay #t)
|
||||
(p "skip w/ c " skip-test mkcskip #t)
|
||||
|
|
@ -204,7 +219,6 @@
|
|||
(display "Using custom interfaces, w/o search\n")
|
||||
(p "splay-tree" splay-test mksplay #f)
|
||||
(p "adj splay " splay-test mksplay #f)
|
||||
(p "dat splay " splay-test mkdsplay #f)
|
||||
(p "skip-list " skip-test mkskip #f)
|
||||
(p "splay w/ c" splay-test mkcsplay #f)
|
||||
(p "skip w/ c " skip-test mkcskip #f)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user