suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added dict-*-contract to racket/dict

Browse Source 
added experimental ordered-dict generics (not public yet, no docs)
This commit is contained in:
Ryan Culpepper 2010-09-14 01:58:29 -06:00
parent 58aa6873fe
commit ae645a18c1
5 changed files with 179 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/data/private/ordered-dict.rkt Normal file
View File

@ -0,0 +1,56 @@
#lang racket/base
(require racket/dict
racket/contract/base
unstable/prop-contract)
(define-values (prop:ordered-dict ordered-dict? ordered-dict-ref)
(make-struct-type-property 'ordered-dict #f))
(define extreme-contract
(->i ([d ordered-dict?])
[_ (d) (or/c #f (dict-iter-contract d))]))
(define search-contract
(->i ([d ordered-dict?]
[k (d) (dict-key-contract d)])
[_ (d) (or/c #f (dict-iter-contract d))]))
(define prop:ordered-dict-contract
(let ([e extreme-contract]
[s search-contract])
(vector-immutable/c e ;; iterate-min
e ;; iterate-max
s ;; iterate-least/>?
s ;; iterate-least/>=?
s ;; iterate-greatest/<?
s)));; iterate-greatest/<=?
;; --------
(define-syntax-rule (appd d offset arg ...)
(let ([dv d])
((vector-ref (ordered-dict-ref dv) offset) dv arg ...)))
(define (dict-iterate-min d)
(appd d 0))
(define (dict-iterate-max d)
(appd d 1))
(define (dict-iterate-least/>? d k)
(appd d 2 k))
(define (dict-iterate-least/>=? d k)
(appd d 3 k))
(define (dict-iterate-greatest/<? d k)
(appd d 4 k))
(define (dict-iterate-greatest/<=? d k)
(appd d 5 k))
(provide/contract
[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/>? search-contract]
[dict-iterate-least/>=? search-contract]
[dict-iterate-greatest/<? search-contract]
[dict-iterate-greatest/<=? search-contract])

63
collects/data/skip-list.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/contract
racket/dict)
racket/dict
"private/ordered-dict.rkt")
;; owned by ryanc
#|
@ -143,10 +144,8 @@ Levels are indexed starting at 1, as in the paper.
;; Skip list
(define make-skip-list*
(let ([make-skip-list
(lambda (=? <?) (make-skip-list (vector 'head 'head #f) 0 =? <?))])
make-skip-list))
(define (make-skip-list =? <?)
(skip-list (vector 'head 'head #f) 0 =? <?))
(define (skip-list-ref s key [default (skip-list-error key)])
(define head (skip-list-head s))
@ -191,7 +190,7 @@ Levels are indexed starting at 1, as in the paper.
(define (skip-list-count s) (skip-list-num-entries s))
(define-struct skip-list-iter (s item))
(struct skip-list-iter (s item))
(define (check-iter who s iter)
(unless (skip-list-iter? iter)
@ -201,12 +200,12 @@ Levels are indexed starting at 1, as in the paper.
(define (skip-list-iterate-first s)
(let ([next (item-next (skip-list-head s) 1)])
(and next (make-skip-list-iter s next))))
(and next (skip-list-iter s next))))
(define (skip-list-iterate-next s iter)
(check-iter 'skip-list-iterate-next s iter)
(let ([next (item-next (skip-list-iter-item iter) 1)])
(and next (make-skip-list-iter s next))))
(and next (skip-list-iter s next))))
(define (skip-list-iterate-key s iter)
(check-iter 'skip-list-iterate-key s iter)
@ -223,7 +222,7 @@ Levels are indexed starting at 1, as in the paper.
(let* ([head (skip-list-head s)]
[<? (skip-list-<? s)]
[item (closest head (item-level head) key <?)])
(and (not (eq? item head)) (make-skip-list-iter s item))))
(and (not (eq? item head)) (skip-list-iter s item))))
;; Returns greatest/rightmost item s.t. key(item) <= key
(define (skip-list-iterate-greatest/<=? s key)
@ -233,21 +232,23 @@ Levels are indexed starting at 1, as in the paper.
[item< (closest head (item-level head) key <?)]
[item1 (item-next item< 1)])
(cond [(and item1 (=? (item-key item1) key))
(make-skip-list-iter s item1)]
(skip-list-iter s item1)]
[(eq? item< head)
#f]
[else
(make-skip-list-iter s item<)])))
(skip-list-iter s item<)])))
;; Returns least/leftmost item s.t. key(item) > key
(define (skip-list-iterate-least/>? s key)
(let* ([head (skip-list-head s)]
[<? (skip-list-<? s)]
[item< (closest head (item-level head) key <?)])
[item< (closest head (item-level head) key <?)]
;; If head, nudge forward one so comparisons are valid.
[item< (if (eq? item< head) (item-next item< 1) item<)])
(let loop ([item item<])
(and item
(if (<? key (item-key item))
(make-skip-list-iter s item)
(skip-list-iter s item)
(loop (item-next item 1)))))))
;; Returns least/leftmost item s.t. key(item) >= key
@ -256,7 +257,21 @@ Levels are indexed starting at 1, as in the paper.
[<? (skip-list-<? s)]
[item (closest head (item-level head) key <?)]
[item (item-next item 1)])
(and item (make-skip-list-iter s item))))
(and item (skip-list-iter s item))))
(define (skip-list-iterate-min 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)
(let* ([head (skip-list-head s)]
[item (closest head (item-level head)
;; replace standard comparison with "always <",
;; so closest yields max item
'unused
(lambda (x y) #t))])
(and item (skip-list-iter s item))))
(define (skip-list-iterate-set-key! s iter key)
(check-iter 'skip-list-iterate-set-key! s iter)
@ -266,8 +281,7 @@ Levels are indexed starting at 1, as in the paper.
(check-iter 'skip-list-iterate-set-value! s iter)
(set-item-data! (skip-list-iter-item iter) value))
(define-struct skip-list ([head #:mutable] [num-entries #:mutable] =? <?)
(struct skip-list ([head #:mutable] [num-entries #:mutable] =? <?)
#:property prop:dict
(vector skip-list-ref
skip-list-set!
@ -278,10 +292,17 @@ Levels are indexed starting at 1, as in the paper.
skip-list-iterate-first
skip-list-iterate-next
skip-list-iterate-key
skip-list-iterate-value))
skip-list-iterate-value)
#:property prop:ordered-dict
(vector-immutable skip-list-iterate-min
skip-list-iterate-max
skip-list-iterate-least/>?
skip-list-iterate-least/>=?
skip-list-iterate-greatest/<?
skip-list-iterate-greatest/<=?))
(provide/contract
[rename make-skip-list* make-skip-list
[make-skip-list
(-> procedure? procedure? skip-list?)]
[skip-list?
(-> any/c boolean?)]
@ -310,6 +331,12 @@ Levels are indexed starting at 1, as in the paper.
(-> skip-list? any/c (or/c skip-list-iter? #f))]
[skip-list-iterate-least/>=?
(-> skip-list? any/c (or/c skip-list-iter? #f))]
[skip-list-iterate-min
(-> skip-list? (or/c skip-list-iter? #f))]
[skip-list-iterate-max
(-> skip-list? (or/c skip-list-iter? #f))]
[skip-list-iterate-set-key!
(-> skip-list? skip-list-iter? any/c any)]
[skip-list-iterate-set-value!

111
collects/data/splay-tree.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
(require racket/match
racket/dict
racket/contract)
racket/contract
"private/ordered-dict.rkt")
;; ======== Raw splay tree ========
@ -403,44 +404,6 @@ Options
;; ========
(struct splay-tree ([root #:mutable] [size #:mutable] cmp tx)
#:transparent
#:property prop:dict/contract
(list (vector-immutable splay-tree-ref
splay-tree-set!
#f ;; set
splay-tree-remove!
#f ;; remove
splay-tree-count
splay-tree-iterate-first
splay-tree-iterate-next
splay-tree-iterate-key
splay-tree-iterate-value)
(vector-immutable any/c
any/c
splay-tree-iter?
#f #f #f)))
(struct splay-tree* splay-tree (key-c value-c)
#:transparent
#:property prop:dict/contract
(list (vector-immutable splay-tree-ref
splay-tree-set!
#f ;; set
splay-tree-remove!
#f ;; remove
splay-tree-count
splay-tree-iterate-first
splay-tree-iterate-next
splay-tree-iterate-key
splay-tree-iterate-value)
(vector-immutable any/c
any/c
splay-tree-iter?
(lambda (s) (splay-tree*-key-c s))
(lambda (s) (splay-tree*-value-c s))
#f)))
(define-syntax-rule (mkcmp <? =?)
(lambda (x y) (cond [(=? x y) '=] [(<? x y) '<] [else '>])))
@ -467,11 +430,6 @@ In an integer splay tree, keys can be stored relative to their parent nodes.
(define (splay-tree-with-adjust? s)
(splay-tree-tx s))
(define (key-c s)
(if (splay-tree*? s) (splay-tree*-key-c s) any/c))
(define (val-c s)
(if (splay-tree*? s) (splay-tree*-value-c s) any/c))
;; ========
;; Order-based search
@ -499,6 +457,15 @@ In an integer splay tree, keys can be stored relative to their parent nodes.
(define (splay-tree-iterate-least/>? s key)
(extreme 'splay-tree-iterate-least/>? s key '(>) has-next? find-next))
(define (splay-tree-iterate-min s)
(splay-tree-iterate-first s))
(define (splay-tree-iterate-max s)
(match s
[(splay-tree root size cmp tx)
(let-values ([(ok? root) (find-max tx root)])
(set-splay-tree-root! s root)
(if ok? (splay-tree-iter (node-key root)) #f))]))
;; ========
;; snapshot
@ -517,6 +484,57 @@ In an integer splay tree, keys can be stored relative to their parent nodes.
;; ========
(define (key-c s)
(if (splay-tree*? s) (splay-tree*-key-c s) any/c))
(define (val-c s)
(if (splay-tree*? s) (splay-tree*-value-c s) any/c))
(define dict-methods
(vector-immutable splay-tree-ref
splay-tree-set!
#f ;; set
splay-tree-remove!
#f ;; remove
splay-tree-count
splay-tree-iterate-first
splay-tree-iterate-next
splay-tree-iterate-key
splay-tree-iterate-value))
(define ordered-dict-methods
(vector-immutable splay-tree-iterate-min
splay-tree-iterate-max
splay-tree-iterate-least/>?
splay-tree-iterate-least/>=?
splay-tree-iterate-greatest/<?
splay-tree-iterate-greatest/<=?))
(struct splay-tree ([root #:mutable] [size #:mutable] cmp tx)
#:transparent
#:property prop:dict/contract
(list dict-methods
(vector-immutable any/c
any/c
splay-tree-iter?
#f #f #f))
#:property prop:ordered-dict
ordered-dict-methods)
(struct splay-tree* splay-tree (key-c value-c)
#:transparent
#:property prop:dict/contract
(list dict-methods
(vector-immutable any/c
any/c
splay-tree-iter?
(lambda (s) (splay-tree*-key-c s))
(lambda (s) (splay-tree*-value-c s))
#f))
#:property prop:ordered-dict
ordered-dict-methods)
;; ========
(provide/contract
[make-splay-tree
(->* ((-> any/c any/c any) (-> any/c any/c any))
@ -572,4 +590,9 @@ In an integer splay tree, keys can be stored relative to their parent nodes.
[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? (or/c splay-tree-iter? #f))]
[splay-tree-iterate-max
(-> splay-tree? (or/c splay-tree-iter? #f))]
[splay-tree-iter? (-> any/c boolean?)])

6
collects/racket/dict.rkt
View File

@ -228,4 +228,8 @@
in-dict
in-dict-keys
in-dict-values
in-dict-pairs)
in-dict-pairs
dict-key-contract
dict-value-contract
dict-iter-contract)

27
collects/tests/data/ordered-dict.rkt
View File

@ -2,28 +2,13 @@
(require rackunit
racket/dict
data/skip-list
data/splay-tree)
data/splay-tree
data/private/ordered-dict)
;; Tests for ordered dictionaries
;; - skip-list
;; - splay-tree
(define (it-least/>? d k)
(cond [(skip-list? d) (skip-list-iterate-least/>? d k)]
[(splay-tree? d) (splay-tree-iterate-least/>? d k)]))
(define (it-least/>=? d k)
(cond [(skip-list? d) (skip-list-iterate-least/>=? d k)]
[(splay-tree? d) (splay-tree-iterate-least/>=? d k)]))
(define (it-greatest/<? d k)
(cond [(skip-list? d) (skip-list-iterate-greatest/<? d k)]
[(splay-tree? d) (splay-tree-iterate-greatest/<? d k)]))
(define (it-greatest/<=? d k)
(cond [(skip-list? d) (skip-list-iterate-greatest/<=? d k)]
[(splay-tree? d) (splay-tree-iterate-greatest/<=? d k)]))
(test-case "random keys and values"
(let ([hash (make-hash)]
[dicts (list (make-skip-list = <)
@ -46,10 +31,10 @@
(let* ([k0 (- (random 2000) 1000)])
(for ([d dicts])
(let* ([has? (dict-has-key? d k0)]
[l>i (it-least/>? d k0)]
[l>=i (it-least/>=? d k0)]
[g<i (it-greatest/<? d k0)]
[g<=i (it-greatest/<=? d k0)]
[l>i (dict-iterate-least/>? d k0)]
[l>=i (dict-iterate-least/>=? d k0)]
[g<i (dict-iterate-greatest/<? d k0)]
[g<=i (dict-iterate-greatest/<=? d k0)]
[l> (and l>i (dict-iterate-key d l>i))]
[l>= (and l>=i (dict-iterate-key d l>=i))]
[g< (and g<i (dict-iterate-key d g<i))]