restricted interval-map interface, simplified code, based on splay-trees
removed old, awful skip-list iteration-mutation procedures updated skip-lists
This commit is contained in:
Ryan Culpepper
parent
f663307252
commit
076bba5ee9
|
|
@ -3,37 +3,22 @@
|
|||
(require racket/contract
|
||||
racket/promise
|
||||
racket/dict
|
||||
data/skip-list)
|
||||
data/splay-tree)
|
||||
|
||||
;; NOTE-1
|
||||
;; I need to be able to split intervals. So I can either have
|
||||
;; closed intervals on the integers or half-open intervals of
|
||||
;; arbitrary total orders. I'm going to do half-open intervals.
|
||||
;; Interval-maps support only half-open exact-integer intervals.
|
||||
|
||||
;; An interval-map is (make-interval-map skip-list =? <? translate)
|
||||
;; skip-list maps Start => (cons End Value)
|
||||
;; An interval-map is (interval-map adj-splay-tree)
|
||||
;; splay-tree maps Start => (cons End-Start Value)
|
||||
;; Invariant: intervals are disjoint (but the end of one interval
|
||||
;; can be the same as the start of the next, since half-open).
|
||||
|
||||
(define make-interval-map*
|
||||
(let ([make-interval-map
|
||||
(lambda (=? <? [translate #f])
|
||||
(make-interval-map (make-skip-list =? <?) =? <? translate))])
|
||||
make-interval-map))
|
||||
|
||||
(define (make-numeric-interval-map)
|
||||
(define (translate x y)
|
||||
(let ([offset (- y x)])
|
||||
(lambda (z) (+ z offset))))
|
||||
(make-interval-map* = < translate))
|
||||
|
||||
(define (interval-map-ref im key [default (interval-map-error key)])
|
||||
(let* ([s (interval-map-s im)]
|
||||
[<? (interval-map-<? im)]
|
||||
[istart (skip-list-iterate-greatest/<=? s key)])
|
||||
[istart (splay-tree-iterate-greatest/<=? s key)])
|
||||
(cond [istart
|
||||
(let ([istartvalue (skip-list-iterate-value s istart)])
|
||||
(if (<? key (car istartvalue))
|
||||
(let ([istartkey (splay-tree-iterate-key s istart)]
|
||||
[istartvalue (splay-tree-iterate-value s istart)])
|
||||
(if (< (- key istartkey) (car istartvalue))
|
||||
(cdr istartvalue)
|
||||
(if (procedure? default) (default) default)))]
|
||||
[else
|
||||
|
|
@ -46,37 +31,40 @@
|
|||
;; (if (start <= x < end)
|
||||
;; (updater (PRE x default))
|
||||
;; (PRE x))
|
||||
(define (interval-map-update*! im start end updater [default (error-for 'interval-map-update*!)])
|
||||
(define (interval-map-update*! im start end updater
|
||||
[default (error-for 'interval-map-update*!)])
|
||||
(define updated-defaultp
|
||||
(delay (updater (if (procedure? default) (default) default))))
|
||||
(let ([s (interval-map-s im)]
|
||||
[<? (interval-map-<? im)]
|
||||
[=? (interval-map-=? im)])
|
||||
(check-interval im start end 'interval-map-update*!)
|
||||
(split! s start <?)
|
||||
(split! s end <?)
|
||||
(let ([s (interval-map-s im)])
|
||||
(check-interval start end 'interval-map-update*!)
|
||||
(split! s start)
|
||||
(split! s end)
|
||||
;; Interval ix needs updating iff start <= key(ix) < end
|
||||
;; (Also need to insert missing intervals)
|
||||
;; Main loop:
|
||||
(let loop ([start start] [ix (skip-list-iterate-least/>=? s start)])
|
||||
(let ([ixstart (and ix (skip-list-iterate-key s ix))])
|
||||
(cond [(and ix (<? ixstart end))
|
||||
(let loop ([start start] [ix (splay-tree-iterate-least/>=? s start)])
|
||||
(let ([ixstart (and ix (splay-tree-iterate-key s ix))])
|
||||
(cond [(and ix (< ixstart end))
|
||||
;; First do leading gap, [ start, key(ix) )
|
||||
(when (<? start ixstart)
|
||||
(skip-list-set! s start (cons ixstart (force updated-defaultp))))
|
||||
(when (< start ixstart)
|
||||
(splay-tree-set! s start
|
||||
(cons (- ixstart start)
|
||||
(force updated-defaultp))))
|
||||
;; Then interval, [ ixstart, end(ix) )
|
||||
(let ([ixvalue (skip-list-iterate-value s ix)])
|
||||
(skip-list-iterate-set-value! s ix
|
||||
(cons (car ixvalue) (updater (cdr ixvalue))))
|
||||
(loop (car ixvalue) (skip-list-iterate-next s ix)))]
|
||||
(let ([ixvalue (splay-tree-iterate-value s ix)])
|
||||
(splay-tree-set! s ixstart
|
||||
(cons (car ixvalue)
|
||||
(updater (cdr ixvalue))))
|
||||
(loop (+ ixstart (car ixvalue)) (splay-tree-iterate-next s ix)))]
|
||||
[else
|
||||
;; Do gap, [ start, end )
|
||||
(when (<? start end)
|
||||
(skip-list-set! s start (cons end (force updated-defaultp))))])))))
|
||||
|
||||
(when (< start end)
|
||||
(splay-tree-set! s start
|
||||
(cons (- end start)
|
||||
(force updated-defaultp))))])))))
|
||||
|
||||
(define (interval-map-cons*! im start end obj [default null])
|
||||
(check-interval im start end 'interval-map-cons*!)
|
||||
(check-interval start end 'interval-map-cons*!)
|
||||
(interval-map-update*! im start end (lambda (old) (cons obj old)) default))
|
||||
|
||||
(define ((error-for who))
|
||||
|
|
@ -84,33 +72,46 @@
|
|||
|
||||
;; (POST x) = (if (start <= x < end) value (PRE x))
|
||||
(define (interval-map-set! im start end value)
|
||||
(check-interval im start end 'interval-map-set!)
|
||||
(check-interval start end 'interval-map-set!)
|
||||
(interval-map-remove! im start end)
|
||||
(interval-map-update*! im start end values value))
|
||||
|
||||
(define (interval-map-remove! im start end)
|
||||
(let ([s (interval-map-s im)]
|
||||
[<? (interval-map-<? im)]
|
||||
[=? (interval-map-=? im)])
|
||||
(check-interval im start end 'interval-map-remove!)
|
||||
(split! s start <?)
|
||||
(split! s end <?)
|
||||
;; Interval ix needs removing iff start <= key(ix) < end
|
||||
;; FIXME: add batch remove to skip-lists
|
||||
(let loop ([ix (skip-list-iterate-least/>=? s start)])
|
||||
(when ix
|
||||
(let ([ixstart (skip-list-iterate-key s ix)])
|
||||
(when (<? ixstart end)
|
||||
;; Get next before we remove current
|
||||
(let ([next (skip-list-iterate-next s ix)])
|
||||
(skip-list-remove! s ixstart)
|
||||
(loop next))))))))
|
||||
(let ([s (interval-map-s im)])
|
||||
(check-interval start end 'interval-map-remove!)
|
||||
(let ([start (norm s start 0)]
|
||||
[end (norm s end 1)])
|
||||
(split! s start)
|
||||
(split! s end)
|
||||
(splay-tree-remove-range! s start end))))
|
||||
|
||||
(define (interval-map-contract! im from to)
|
||||
(check-interval from to 'interval-map-contract!)
|
||||
(interval-map-remove! im from to)
|
||||
(let* ([s (interval-map-s im)])
|
||||
(splay-tree-contract! s from to)))
|
||||
|
||||
(define (interval-map-expand! im from to)
|
||||
(check-interval from to 'interval-map-expand!)
|
||||
(let* ([s (interval-map-s im)])
|
||||
(split! s from)
|
||||
(splay-tree-expand! s from to)))
|
||||
|
||||
(define (norm s pos adjust)
|
||||
(cond [(= pos -inf.0)
|
||||
(let ([iter (splay-tree-iterate-min s)])
|
||||
(and iter (splay-tree-iterate-key s iter)))]
|
||||
[(= pos +inf.0)
|
||||
(let ([iter (splay-tree-iterate-max s)])
|
||||
;; add 1 to *include* max (recall, half-open intervals)
|
||||
(and iter (+ 1 (splay-tree-iterate-key s iter))))]
|
||||
[else pos]))
|
||||
|
||||
;; split!
|
||||
;; Ensures that if an interval contains x, it starts at x
|
||||
(define (split! s x <?)
|
||||
(let* ([ix (skip-list-iterate-greatest/<? s x)]
|
||||
[ixstart (and ix (skip-list-iterate-key s ix))])
|
||||
(define (split! s x)
|
||||
(let* ([ix (splay-tree-iterate-greatest/<? s x)]
|
||||
[ixstart (and ix (splay-tree-iterate-key s ix))])
|
||||
;; (ix = #f) or (key(ix) < x)
|
||||
(cond [(eq? ix #f)
|
||||
;; x <= all existing intervals; that is, either
|
||||
|
|
@ -119,129 +120,150 @@
|
|||
;; Either way, nothing to split.
|
||||
(void)]
|
||||
[else
|
||||
(let* ([ixvalue (skip-list-iterate-value s ix)]
|
||||
[ixend (car ixvalue)])
|
||||
(cond [(<? x ixend)
|
||||
;; Split; adjust ix to start at x, insert [ixstart, x)
|
||||
(skip-list-iterate-set-key! s ix x)
|
||||
(skip-list-set! s ixstart (cons x (cdr ixvalue)))]
|
||||
(let* ([ixvalue (splay-tree-iterate-value s ix)]
|
||||
[ixrun (car ixvalue)])
|
||||
(cond [(< x (+ ixstart ixrun))
|
||||
;; Split; adjust ix to end at x, insert [x, ixend)
|
||||
(splay-tree-set! s ixstart (cons (- x ixstart) (cdr ixvalue)))
|
||||
(splay-tree-set! s x (cons (- (+ ixstart ixrun) x) (cdr ixvalue)))]
|
||||
[else
|
||||
;; x not in ix
|
||||
(void)]))])))
|
||||
|
||||
(define (check-interval im start end who)
|
||||
(let ([<? (interval-map-<? im)])
|
||||
(unless (<? start end)
|
||||
(error who "bad interval: start ~e not less than end ~e" start end))))
|
||||
(define (check-interval start end who)
|
||||
(unless (< start end)
|
||||
(error who "bad interval: start ~e not less than end ~e" start end)))
|
||||
|
||||
;; Iteration
|
||||
|
||||
(define-struct interval-map-iter (si))
|
||||
(struct interval-map-iter (si))
|
||||
|
||||
(define (interval-map-iterate-first im)
|
||||
(cond [(skip-list-iterate-first (interval-map-s im))
|
||||
=> make-interval-map-iter]
|
||||
(cond [(splay-tree-iterate-first (interval-map-s im))
|
||||
=> interval-map-iter]
|
||||
[else #f]))
|
||||
|
||||
(define (interval-map-iterate-next im iter)
|
||||
(cond [(skip-list-iterate-next (interval-map-s im)
|
||||
(cond [(splay-tree-iterate-next (interval-map-s im)
|
||||
(interval-map-iter-si iter))
|
||||
=> make-interval-map-iter]
|
||||
=> interval-map-iter]
|
||||
[else #f]))
|
||||
|
||||
(define (interval-map-iterate-key im iter)
|
||||
(let ([s (interval-map-s im)]
|
||||
[is (interval-map-iter-si iter)])
|
||||
(cons (skip-list-iterate-key s is)
|
||||
(car (skip-list-iterate-value s is)))))
|
||||
(let ([key (splay-tree-iterate-key s is)])
|
||||
(cons key (+ key (car (splay-tree-iterate-value s is)))))))
|
||||
|
||||
(define (interval-map-iterate-value im iter)
|
||||
(let ([s (interval-map-s im)]
|
||||
[is (interval-map-iter-si iter)])
|
||||
(cdr (skip-list-iterate-value s is))))
|
||||
(cdr (splay-tree-iterate-value s is))))
|
||||
|
||||
;; ============================================================
|
||||
|
||||
;; Interval map
|
||||
|
||||
(define-struct interval-map (s =? <? translate)
|
||||
#:property prop:dict
|
||||
(vector interval-map-ref
|
||||
#f ;; set!
|
||||
#f ;; set
|
||||
#f ;; remove!
|
||||
#f ;; remove
|
||||
(lambda (im) (error 'interval-map-count "not supported"))
|
||||
interval-map-iterate-first
|
||||
interval-map-iterate-next
|
||||
interval-map-iterate-key
|
||||
interval-map-iterate-value))
|
||||
(define dict-methods
|
||||
(vector-immutable interval-map-ref
|
||||
#f ;; set!
|
||||
#f ;; set
|
||||
#f ;; remove!
|
||||
#f ;; remove
|
||||
(lambda (im) (error 'interval-map-count "not supported"))
|
||||
interval-map-iterate-first
|
||||
interval-map-iterate-next
|
||||
interval-map-iterate-key
|
||||
interval-map-iterate-value))
|
||||
|
||||
(define (interval-map-with-translate? x)
|
||||
(and (interval-map? x)
|
||||
(procedure? (interval-map-translate x))))
|
||||
;; Can't use prop:dict/contract, because we don't really
|
||||
;; follow the dict interface!
|
||||
|
||||
(define (interval-map-contract! im from to)
|
||||
(let ([<? (interval-map-<? im)])
|
||||
(unless (<? from to)
|
||||
(error 'interval-map-contract!
|
||||
"start ~e not less than end ~e" from to)))
|
||||
(interval-map-remove! im from to)
|
||||
(let* ([s (interval-map-s im)]
|
||||
[translate ((interval-map-translate im) to from)])
|
||||
(apply-offset! s translate to)))
|
||||
(struct interval-map (s)
|
||||
#:property prop:dict dict-methods)
|
||||
|
||||
(define (interval-map-expand! im from to)
|
||||
(let ([<? (interval-map-<? im)])
|
||||
(unless (<? from to)
|
||||
(error 'interval-map-expand!
|
||||
"start ~e not less than end ~e" from to))
|
||||
(let* ([s (interval-map-s im)]
|
||||
[translate ((interval-map-translate im) from to)])
|
||||
(split! s from <?)
|
||||
(apply-offset! s translate from))))
|
||||
(struct interval-map* interval-map (key-c value-c)
|
||||
#:property prop:dict dict-methods)
|
||||
|
||||
(define (apply-offset! s translate to)
|
||||
(let loop ([ix (skip-list-iterate-least/>=? s to)])
|
||||
(when ix
|
||||
(let* ([ixkey (skip-list-iterate-key s ix)]
|
||||
[ixvalue (skip-list-iterate-value s ix)])
|
||||
(skip-list-iterate-set-key! s ix (translate ixkey))
|
||||
(skip-list-iterate-set-value! s ix
|
||||
(cons (translate (car ixvalue)) (cdr ixvalue))))
|
||||
(loop (skip-list-iterate-next s ix)))))
|
||||
(define (make-interval-map #:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
(cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
|
||||
(interval-map (make-adjustable-splay-tree))]
|
||||
[else
|
||||
(interval-map* (make-adjustable-splay-tree) key-contract value-contract)]))
|
||||
|
||||
;; ============================================================
|
||||
|
||||
(define (key-c im)
|
||||
(cond [(interval-map*? im)
|
||||
(let ([c (interval-map*-key-c im)])
|
||||
(if (eq? c any/c) exact-integer? (and/c exact-integer? c)))]
|
||||
[else exact-integer?]))
|
||||
(define (val-c im)
|
||||
(cond [(interval-map*? im)
|
||||
(interval-map*-value-c im)]
|
||||
[else any/c]))
|
||||
|
||||
(provide/contract
|
||||
[rename make-interval-map* make-interval-map
|
||||
(-> procedure? procedure? interval-map?)]
|
||||
[make-numeric-interval-map
|
||||
(-> interval-map-with-translate?)]
|
||||
[make-interval-map
|
||||
(->* ()
|
||||
(#:key-contract contract? #:value-contract contract?)
|
||||
interval-map?)]
|
||||
[interval-map?
|
||||
(-> any/c any)]
|
||||
[interval-map-with-translate?
|
||||
(-> any/c any)]
|
||||
(-> any/c boolean?)]
|
||||
[interval-map-ref
|
||||
(->* (interval-map? any/c) (any/c) any)]
|
||||
(->i ([im interval-map?] [k (im) (key-c im)]) ([d any/c]) any)]
|
||||
[interval-map-set!
|
||||
(-> interval-map? any/c any/c any/c any)]
|
||||
(->i ([im interval-map?]
|
||||
[start (im) (key-c im)]
|
||||
[end (im) (key-c im)]
|
||||
[v (im) (val-c im)])
|
||||
[_ void?])]
|
||||
[interval-map-update*!
|
||||
(->* (interval-map? any/c any/c (-> any/c any/c)) (any/c) any)]
|
||||
(->i ([im interval-map?]
|
||||
[start (im) (key-c im)]
|
||||
[end (im) (key-c im)]
|
||||
[f (im) (-> (val-c im) (val-c im))])
|
||||
([default any/c]) ;; imprecise
|
||||
[_ void?])]
|
||||
[interval-map-cons*!
|
||||
(->* (interval-map? any/c any/c any/c) (any/c) any)]
|
||||
(->i ([im interval-map?]
|
||||
[start (im) (key-c im)]
|
||||
[end (im) (key-c im)]
|
||||
[v any/c]) ;; imprecise
|
||||
([d any/c]) ;; imprecise
|
||||
[_ void?])]
|
||||
[interval-map-remove!
|
||||
(-> interval-map? any/c any/c any)]
|
||||
(->i ([im interval-map?]
|
||||
[start (im) (or/c -inf.0 (key-c im))]
|
||||
[end (im) (or/c +inf.0 (key-c im))])
|
||||
[_ void?])]
|
||||
[interval-map-contract!
|
||||
(-> interval-map-with-translate? any/c any/c any)]
|
||||
(->i ([im interval-map?]
|
||||
[start (im) (key-c im)]
|
||||
[end (im) (key-c im)])
|
||||
[_ void?])]
|
||||
[interval-map-expand!
|
||||
(-> interval-map-with-translate? any/c any/c any)]
|
||||
(->i ([im interval-map?]
|
||||
[start (im) (key-c im)]
|
||||
[end (im) (key-c im)])
|
||||
[_ void?])]
|
||||
|
||||
[interval-map-iterate-first
|
||||
(-> interval-map? (or/c interval-map-iter? #f))]
|
||||
(-> interval-map?
|
||||
(or/c interval-map-iter? #f))]
|
||||
[interval-map-iterate-next
|
||||
(-> interval-map? interval-map-iter? (or/c interval-map-iter? #f))]
|
||||
(-> interval-map? interval-map-iter?
|
||||
(or/c interval-map-iter? #f))]
|
||||
[interval-map-iterate-key
|
||||
(-> interval-map? interval-map-iter? any)]
|
||||
(->i ([im interval-map?] [i interval-map-iter?])
|
||||
[_ (im) (let ([k (key-c im)]) (cons/c k k))])]
|
||||
[interval-map-iterate-value
|
||||
(-> interval-map? interval-map-iter? any)]
|
||||
(->i ([im interval-map?] [i interval-map-iter?])
|
||||
[_ (im) (val-c im)])]
|
||||
|
||||
[interval-map-iter?
|
||||
(-> any/c any)])
|
||||
(-> any/c boolean?)])
|
||||
|
||||
#|
|
||||
;; Testing
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
racket/dict
|
||||
racket/base))
|
||||
|
||||
@title[#:tag "gvector"]{Growable vectors}
|
||||
@title[#:tag "gvector"]{Growable Vectors}
|
||||
|
||||
@(define the-eval (make-base-eval))
|
||||
@(the-eval '(require data/gvector))
|
||||
|
|
|
|||
|
|
@ -15,52 +15,35 @@
|
|||
|
||||
@author[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
|
||||
|
||||
An interval-map is a mutable dictionary-like data structure where
|
||||
mappings are added by @emph{half-open} intervals and queried by
|
||||
discrete points. Interval-maps can be used with any total
|
||||
order. Internally, an interval-map uses a skip-list
|
||||
(@racketmodname[data/skip-list]) of intervals for efficient query
|
||||
and update.
|
||||
An interval-map is a mutable data structure that maps @emph{half-open}
|
||||
intervals of exact integers to values. An interval-map is queried at a
|
||||
discrete point, and the result of the query is the value mapped to the
|
||||
interval containing the point.
|
||||
|
||||
Internally, interval-maps use a splay-tree
|
||||
(@racketmodname[data/splay-tree]) of intervals for efficient query and
|
||||
update, including efficient contraction and expansion of intervals.
|
||||
|
||||
Interval-maps implement the dictionary (@racketmodname[racket/dict])
|
||||
interface to a limited extent. Only @racket[dict-ref] and the
|
||||
iteraction-based methods (@racket[dict-iterate-first],
|
||||
iteration-based methods (@racket[dict-iterate-first],
|
||||
@racket[dict-map], etc) are supported. For the iteration-based
|
||||
methods, the mapping's keys are considered the pairs of the start and
|
||||
end positions of the mapping's intervals.
|
||||
|
||||
@examples[#:eval the-eval
|
||||
(define r (make-numeric-interval-map))
|
||||
(define r (make-interval-map))
|
||||
(interval-map-set! r 1 5 'apple)
|
||||
(interval-map-set! r 6 10 'pear)
|
||||
(interval-map-set! r 3 6 'banana)
|
||||
(interval-map-set! r 3 7 'banana)
|
||||
(dict-map r list)
|
||||
]
|
||||
|
||||
@defproc[(make-interval-map [=? (any/c any/c . -> . any/c)]
|
||||
[<? (any/c any/c . -> . any/c)]
|
||||
[translate (or/c (any/c any/c . -> . (any/c . -> . any/c)) #f) #f])
|
||||
@defproc[(make-interval-map [#:key-contract key-contract contract? any/c]
|
||||
[#:value-contract value-contract contract? any/c])
|
||||
interval-map?]{
|
||||
|
||||
Makes a new empty interval-map. The interval-map uses @racket[=?] and
|
||||
@racket[<?] to order the endpoints of intervals.
|
||||
|
||||
If @racket[translate] is a procedure, the interval-map supports
|
||||
contraction and expansion of regions of its domain via
|
||||
@racket[interval-map-contract!] and @racket[interval-map-expand!]. See
|
||||
also @racket[make-numeric-interval-map].
|
||||
}
|
||||
|
||||
@defproc[(make-numeric-interval-map)
|
||||
interval-map-with-translate?]{
|
||||
|
||||
Makes a new empty interval-map suitable for representing numeric
|
||||
ranges.
|
||||
|
||||
Equivalent to
|
||||
@racketblock[
|
||||
(make-interval-map = < (lambda (x y) (lambda (z) (+ z (- y x)))))
|
||||
]
|
||||
Makes a new empty interval-map.
|
||||
}
|
||||
|
||||
@defproc[(interval-map? [v any/c])
|
||||
|
|
@ -70,15 +53,8 @@ Returns @racket[#t] if @racket[v] is an interval-map, @racket[#f]
|
|||
otherwise.
|
||||
}
|
||||
|
||||
@defproc[(interval-map-with-translate? [v any/c])
|
||||
boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] is an interval-map constructed with
|
||||
support for translation of keys, @racket[#f] otherwise.
|
||||
}
|
||||
|
||||
@defproc[(interval-map-ref [interval-map interval-map?]
|
||||
[position any/c]
|
||||
[position exact-integer?]
|
||||
[default any/c (lambda () (error ....))])
|
||||
any/c]{
|
||||
|
||||
|
|
@ -88,8 +64,8 @@ applied if it is a procedure, or returned otherwise.
|
|||
}
|
||||
|
||||
@defproc[(interval-map-set! [interval-map interval-map?]
|
||||
[start any/c]
|
||||
[end any/c]
|
||||
[start exact-integer?]
|
||||
[end exact-integer?]
|
||||
[value any/c])
|
||||
void?]{
|
||||
|
||||
|
|
@ -103,9 +79,9 @@ preserves distinctions within [@racket[start], @racket[end]).
|
|||
}
|
||||
|
||||
@defproc[(interval-map-update*! [interval-map interval-map?]
|
||||
[start any/c]
|
||||
[end any/c]
|
||||
[updater (any/c . -> . any/c)]
|
||||
[start exact-integer?]
|
||||
[end exact-integer?]
|
||||
[updater (-> any/c any/c)]
|
||||
[default any/c (lambda () (error ....))])
|
||||
void?]{
|
||||
|
||||
|
|
@ -119,40 +95,36 @@ preserves existing distinctions within [@racket[start], @racket[end]).
|
|||
}
|
||||
|
||||
@defproc[(interval-map-remove! [interval-map interval-map?]
|
||||
[start any/c]
|
||||
[end any/c])
|
||||
[start (or/c exact-integer? -inf.0)]
|
||||
[end (or/c exact-integer? +inf.0)])
|
||||
void?]{
|
||||
|
||||
Removes the value associated with every position in [@racket[start],
|
||||
@racket[end]).
|
||||
}
|
||||
|
||||
@defproc[(interval-map-expand! [interval-map interval-map-with-translate?]
|
||||
[start any/c]
|
||||
[end any/c])
|
||||
void?]{
|
||||
|
||||
Expands @racket[interval-map]'s domain by introducing a gap
|
||||
[@racket[start], @racket[end]) and adjusting intervals after
|
||||
@racket[start] using @racket[(_translate start end)].
|
||||
|
||||
If @racket[interval-map] was not constructed with a
|
||||
@racket[_translate] argument, an exception is raised. If
|
||||
@racket[start] is not less than @racket[end], an exception is raised.
|
||||
}
|
||||
|
||||
@defproc[(interval-map-contract! [interval-map interval-map-with-translate?]
|
||||
[start any/c]
|
||||
[end any/c])
|
||||
@defproc[(interval-map-contract! [interval-map interval-map?]
|
||||
[start exact-integer?]
|
||||
[end exact-integer?])
|
||||
void?]{
|
||||
|
||||
Contracts @racket[interval-map]'s domain by removing all mappings on
|
||||
the interval [@racket[start], @racket[end]) and adjusting intervals
|
||||
after @racket[end] using @racket[(_translate end start)].
|
||||
the interval [@racket[start], @racket[end]) and decreasing intervals
|
||||
initally after @racket[end] by @racket[(- end start)].
|
||||
|
||||
If @racket[interval-map] was not constructed with a
|
||||
@racket[_translate] argument, an exception is raised. If
|
||||
@racket[start] is not less than @racket[end], an exception is raised.
|
||||
If @racket[start] is not less than @racket[end], an exception is raised.
|
||||
}
|
||||
|
||||
@defproc[(interval-map-expand! [interval-map interval-map?]
|
||||
[start exact-integer?]
|
||||
[end exact-integer?])
|
||||
void?]{
|
||||
|
||||
Expands @racket[interval-map]'s domain by introducing a gap
|
||||
[@racket[start], @racket[end]) and increasing intervals initially after
|
||||
@racket[start] by @racket[(- end start)].
|
||||
|
||||
If @racket[start] is not less than @racket[end], an exception is raised.
|
||||
}
|
||||
|
||||
@defproc[(interval-map-cons*! [interval-map interval-map?]
|
||||
|
|
|
|||
|
|
@ -44,12 +44,28 @@ Makes a new empty skip-list. The skip-list uses @racket[=?] and
|
|||
]
|
||||
}
|
||||
|
||||
@defproc[(skip-list? [v any/c])
|
||||
boolean?]{
|
||||
@defproc[(make-adjustable-skip-list
|
||||
[#:key-contract key-contract contract? any/c]
|
||||
[#:value-contract value-contract contract? any/c])
|
||||
adjustable-skip-list?]{
|
||||
|
||||
Makes a new empty skip-list that permits only exact integers as keys
|
||||
(in addition to any constraints imposed by @racket[key-contract]). The
|
||||
resulting skip-list answers true to @racket[adjustable-skip-list?]
|
||||
and supports key adjustment.
|
||||
}
|
||||
|
||||
@defproc[(skip-list? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] is a skip-list, @racket[#f]
|
||||
otherwise.
|
||||
}
|
||||
|
||||
@defproc[(adjustable-skip-list? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] is a skip-list that supports key
|
||||
adjustment; see @racket[skip-list-contract!] and
|
||||
@racket[skip-list-expand!].
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
|
|
@ -85,6 +101,40 @@ Implementations of @racket[dict-ref], @racket[dict-set!],
|
|||
respectively.
|
||||
}
|
||||
|
||||
@defproc[(skip-list-remove-range! [skip-list skip-list?]
|
||||
[from any/c]
|
||||
[to any/c])
|
||||
void?]{
|
||||
|
||||
Removes all keys in [@racket[from], @racket[to]); that is, all keys
|
||||
greater than or equal to @racket[from] and less than @racket[to].
|
||||
}
|
||||
|
||||
@defproc[(skip-list-contract! [skip-list adjustable-skip-list?]
|
||||
[from exact-integer?]
|
||||
[to exact-integer?])
|
||||
void?]{
|
||||
|
||||
Like @racket[skip-list-remove-range!], but also decreases the value
|
||||
of all keys greater than or equal to @racket[to] by @racket[(- to
|
||||
from)].
|
||||
|
||||
This operation takes time proportional to the number of elements with
|
||||
keys greater than or equal to @racket[to].
|
||||
}
|
||||
|
||||
@defproc[(skip-list-expand! [skip-list adjustable-skip-list?]
|
||||
[from exact-integer?]
|
||||
[to exact-integer?])
|
||||
void?]{
|
||||
|
||||
Increases the value of all keys greater than or equal to @racket[from]
|
||||
by @racket[(- to from)].
|
||||
|
||||
This operation takes time proportional to the number of elements with
|
||||
keys greater than or equal to @racket[from].
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(skip-list-iterate-greatest/<? [skip-list skip-list?]
|
||||
[key any/c])
|
||||
|
|
@ -105,28 +155,14 @@ least key greater than @racket[key], and the least key greater than or
|
|||
equal to @racket[key].
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
@defproc[(skip-list-iterate-set-key! [skip-list skip-list?]
|
||||
[iter skip-list-iter?]
|
||||
[key any/c])
|
||||
void?]
|
||||
@defproc[(skip-list-iterate-set-value! [skip-list skip-list?]
|
||||
[iter skip-list-iter?]
|
||||
[value any/c])
|
||||
void?]]]{
|
||||
|
||||
Set the key and value, respectively, at the position @racket[iter] in
|
||||
@racket[skip-list].
|
||||
|
||||
@bold{Warning:} Changing a position's key to be less than its
|
||||
predecessor's key or greater than its successor's key results in an
|
||||
out-of-order skip-list, which may cause comparison-based operations to
|
||||
behave incorrectly.
|
||||
}
|
||||
|
||||
@defproc[(skip-list-iter? [v any/c])
|
||||
boolean?]{
|
||||
@defproc[(skip-list-iter? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] represents a position in a
|
||||
skip-list, @racket[#f] otherwise.
|
||||
}
|
||||
|
||||
@defproc[(skip-list->list [skip-list skip-list?]) (listof pair?)]{
|
||||
|
||||
Returns an association list with the keys and values of
|
||||
@racket[skip-list], in order.
|
||||
}
|
||||
|
|
|
|||
|
|
@ -106,28 +106,39 @@ Implementations of @racket[dict-ref], @racket[dict-set!],
|
|||
respectively.
|
||||
}
|
||||
|
||||
@defproc[(splay-tree-remove-range! [s splay-tree?] [from any/c] [to any/c])
|
||||
@defproc[(splay-tree-remove-range! [s splay-tree?]
|
||||
[from any/c]
|
||||
[to any/c])
|
||||
void?]{
|
||||
|
||||
Removes all keys in [@racket[from], @racket[to]); that is, all keys
|
||||
greater than or equal to @racket[from] and less than @racket[to].
|
||||
|
||||
This operation takes @italic{O(N)} time, or @italic{O(log N)} time if
|
||||
@racket[(adjustable-splay-tree? s)].
|
||||
}
|
||||
|
||||
@defproc[(splay-tree-contract! [s adjustable-splay-tree?]
|
||||
[from any/c] [to any/c])
|
||||
[from exact-integer?] [to exact-integer?])
|
||||
void?]{
|
||||
|
||||
Like @racket[splay-tree-remove-range!], but also decreases the value
|
||||
of all keys greater than or equal to @racket[to] by @racket[(- to
|
||||
from)].
|
||||
|
||||
This operation is only allowed on adjustable splay trees, and it takes
|
||||
@italic{O(log N)} time.
|
||||
}
|
||||
|
||||
@defproc[(splay-tree-expand! [s adjustable-splay-tree?]
|
||||
[from any/c] [to any/c])
|
||||
[from exact-integer?] [to exact-integer?])
|
||||
void?]{
|
||||
|
||||
Increases the value of all keys greater than or equal to @racket[from]
|
||||
by @racket[(- to from)].
|
||||
|
||||
This operation is only allowed on adjustable splay trees, and it takes
|
||||
@italic{O(log N)} time.
|
||||
}
|
||||
|
||||
@deftogether[[
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
(require racket/contract
|
||||
(require racket/match
|
||||
racket/contract
|
||||
racket/dict
|
||||
"private/ordered-dict.rkt")
|
||||
;; owned by ryanc
|
||||
|
|
@ -67,7 +68,7 @@ Levels are indexed starting at 1, as in the paper.
|
|||
|
||||
;; closest : Item Nat Key Cmp Cmp -> Item
|
||||
;; Returns greatest item R s.t. key(R) <? key.
|
||||
;; Pre: level(item) >= level, key <? key(item) OR item = head
|
||||
;; Pre: level(item) >= level, key(item) <? key OR item = head
|
||||
(define (closest item level key <?)
|
||||
(if (zero? level)
|
||||
item
|
||||
|
|
@ -75,7 +76,7 @@ Levels are indexed starting at 1, as in the paper.
|
|||
|
||||
;; advance : Item Nat Key Cmp -> Item
|
||||
;; Returns greatest item R s.t. key(R) <? key and level(R) >= level.
|
||||
;; Pre: level(item) >= level, key <? key(item) OR item = head
|
||||
;; Pre: level(item) >= level, key(item) <? key OR item = head
|
||||
(define (advance item level key <?)
|
||||
(let ([next (item-next item level)])
|
||||
(if (and next (<? (item-key next) key))
|
||||
|
|
@ -94,7 +95,7 @@ Levels are indexed starting at 1, as in the paper.
|
|||
;; Updates skip-list so that key |-> data
|
||||
;; Returns #f to indicate update (existing item changed);
|
||||
;; returns item to indicate insertion (context's links need updating)
|
||||
;; Pre: level(item) >= level, key <? key(item) OR item = head
|
||||
;; Pre: level(item) >= level, key(item) <? key OR item = head
|
||||
(define (update/insert item level key data =? <? max-level)
|
||||
(cond [(positive? level)
|
||||
(let* ([item (advance item level key <?)]
|
||||
|
|
@ -122,7 +123,7 @@ Levels are indexed starting at 1, as in the paper.
|
|||
;; delete : ... -> Item/#f
|
||||
;; Returns item to indicate deletion (context's links need updating);
|
||||
;; returns #f if not found.
|
||||
;; Pre: level(item) >= level; key <? key(item) OR item = head
|
||||
;; Pre: level(item) >= level; key(item) <? key OR item = head
|
||||
(define (delete item level key =? <?)
|
||||
(cond [(positive? level)
|
||||
(let* ([item (advance item level key <?)]
|
||||
|
|
@ -141,6 +142,39 @@ Levels are indexed starting at 1, as in the paper.
|
|||
;; Not found!
|
||||
#f]))]))
|
||||
|
||||
;; delete-range : ... -> void
|
||||
;; Pre: level(*-item) >= level; key(*-item) <? *-key OR *-item = head
|
||||
(define (delete-range f-item t-item level f-key t-key <? contract!?)
|
||||
(cond [(positive? level)
|
||||
(let* ([f-item (advance f-item level f-key <?)]
|
||||
[t-item (advance t-item level t-key <?)]
|
||||
;; 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 <?))]
|
||||
[else
|
||||
;; f-item is greatest s.t. key(item) <? f-key
|
||||
;; so f-item is greatest s.t. key(item) <? t-key,
|
||||
;; because deleted [f-key, t-key)
|
||||
(when contract!?
|
||||
(let ([delta (- t-key f-key)])
|
||||
(let loop ([item (item-next f-item 1)])
|
||||
(when item
|
||||
;; key(item) >=? t-key
|
||||
(set-item-key! item (- (item-key item) delta))
|
||||
(loop (item-next item 1))))))]))
|
||||
|
||||
;; expand! : ... -> void
|
||||
(define (expand! item level from to <?)
|
||||
(let ([delta (- to from)]
|
||||
[item (closest item level from <?)])
|
||||
;; item greatest s.t. key(item) <? from
|
||||
(let loop ([item (item-next item 1)])
|
||||
(when item
|
||||
;; key(item) >=? from
|
||||
(set-item-key! item (+ (item-key item) delta))
|
||||
(loop (item-next item 1))))))
|
||||
|
||||
|
||||
;; Skip list
|
||||
|
||||
|
|
@ -163,7 +197,8 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(define result ;; new Item or #f
|
||||
(update/insert head (item-level head) key data =? <? max-level))
|
||||
(when result
|
||||
(set-skip-list-num-entries! s (add1 (skip-list-count s)))
|
||||
(when (skip-list-num-entries s)
|
||||
(set-skip-list-num-entries! s (add1 (skip-list-count s))))
|
||||
(when (> (item-level result) (item-level head))
|
||||
(let ([new-head (resize-item head (item-level result))])
|
||||
(set-item-next! new-head (item-level result) result)
|
||||
|
|
@ -175,7 +210,7 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(define <? (skip-list-<? s))
|
||||
(define deleted
|
||||
(delete head (item-level head) key =? <?))
|
||||
(when deleted
|
||||
(when (and deleted (skip-list-num-entries s))
|
||||
(set-skip-list-num-entries! s (sub1 (skip-list-count s))))
|
||||
(unless (or (item? (item-next head (item-level head)))
|
||||
(= 1 (item-level head)))
|
||||
|
|
@ -183,9 +218,33 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(let ([new-head (resize-item head (sub1 (item-level head)))])
|
||||
(set-skip-list-head! s new-head))))
|
||||
|
||||
(define (skip-list-remove-range! s from to)
|
||||
(match s
|
||||
[(skip-list head count =? <?)
|
||||
(delete-range head head (item-level head) from to <? #f)
|
||||
(set-skip-list-num-entries! s #f)]))
|
||||
|
||||
(define (skip-list-contract! s from to)
|
||||
(match s
|
||||
[(adjustable-skip-list head count =? <?)
|
||||
(delete-range head head (item-level head) from to <? #t)
|
||||
(set-skip-list-num-entries! s #f)]))
|
||||
|
||||
(define (skip-list-expand! s from to)
|
||||
(match s
|
||||
[(adjustable-skip-list head count =? <?)
|
||||
(expand! head (item-level head) from to <?)]))
|
||||
|
||||
;; Dict methods
|
||||
|
||||
(define (skip-list-count s) (skip-list-num-entries s))
|
||||
(define (skip-list-count s)
|
||||
(let ([n (skip-list-num-entries s)])
|
||||
(or n
|
||||
(let loop ([n 0] [item (item-next (skip-list-head s) 1)])
|
||||
(cond [item (loop (add1 n) (item-next item 1))]
|
||||
[else
|
||||
(set-skip-list-num-entries! s n)
|
||||
n])))))
|
||||
|
||||
(struct skip-list-iter (s item))
|
||||
|
||||
|
|
@ -270,13 +329,14 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(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)
|
||||
(set-item-key! (skip-list-iter-item iter) key))
|
||||
(define (skip-list->list s)
|
||||
(let loop ([item (item-next (skip-list-head s) 1)])
|
||||
(if item
|
||||
(cons (cons (item-key item) (item-data item))
|
||||
(loop (item-next item 1)))
|
||||
null)))
|
||||
|
||||
(define (skip-list-iterate-set-value! s iter value)
|
||||
(check-iter 'skip-list-iterate-set-value! s iter)
|
||||
(set-item-data! (skip-list-iter-item iter) value))
|
||||
;; ============================================================
|
||||
|
||||
(define dict-methods
|
||||
(vector-immutable skip-list-ref
|
||||
|
|
@ -314,6 +374,21 @@ Levels are indexed starting at 1, as in the paper.
|
|||
#f))
|
||||
#:property prop:ordered-dict ordered-dict-methods)
|
||||
|
||||
(struct adjustable-skip-list skip-list ()
|
||||
#:property prop:dict/contract
|
||||
(list dict-methods
|
||||
(vector-immutable exact-integer? any/c skip-list-iter?
|
||||
#f #f #f)))
|
||||
|
||||
(struct adjustable-skip-list* adjustable-skip-list (key-c value-c)
|
||||
#:property prop:dict/contract
|
||||
(list dict-methods
|
||||
(vector-immutable exact-integer? any/c skip-list-iter?
|
||||
(lambda (s) (adjustable-skip-list*-key-c s))
|
||||
(lambda (s) (adjustable-skip-list*-value-c s))
|
||||
#f))
|
||||
#:property prop:ordered-dict ordered-dict-methods)
|
||||
|
||||
(define (make-skip-list =? <?
|
||||
#:key-contract [key-contract any/c]
|
||||
#:value-contract [value-contract any/c])
|
||||
|
|
@ -322,11 +397,23 @@ Levels are indexed starting at 1, as in the paper.
|
|||
[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])
|
||||
(cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
|
||||
(adjustable-skip-list (vector 'head 'head #f) 0 = <)]
|
||||
[else
|
||||
(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)))]
|
||||
[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]))
|
||||
|
||||
(provide/contract
|
||||
|
|
@ -334,8 +421,14 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(->* ((-> any/c any/c any/c) (-> any/c any/c any/c))
|
||||
(#:key-contract contract? #:value-contract contract?)
|
||||
skip-list?)]
|
||||
[make-adjustable-skip-list
|
||||
(->* ()
|
||||
(#:key-contract contract? #:value-contract contract?)
|
||||
adjustable-skip-list?)]
|
||||
[skip-list?
|
||||
(-> any/c boolean?)]
|
||||
[adjustable-skip-list?
|
||||
(-> any/c boolean?)]
|
||||
|
||||
[skip-list-ref
|
||||
(->i ([s skip-list?] [k (s) (key-c s)])
|
||||
|
|
@ -347,6 +440,17 @@ Levels are indexed starting at 1, as in the paper.
|
|||
(->i ([s skip-list?] [k (s) (key-c s)]) [_ void?])]
|
||||
[skip-list-count
|
||||
(-> skip-list? exact-nonnegative-integer?)]
|
||||
|
||||
[skip-list-remove-range!
|
||||
(->i ([s skip-list?] [from (s) (key-c s)] [to (s) (key-c s)])
|
||||
[_ void?])]
|
||||
[skip-list-contract!
|
||||
(->i ([s adjustable-skip-list?] [from (s) (key-c s)] [to (s) (key-c s)])
|
||||
[_ void?])]
|
||||
[skip-list-expand!
|
||||
(->i ([s adjustable-skip-list?] [from (s) (key-c s)] [to (s) (key-c s)])
|
||||
[_ void?])]
|
||||
|
||||
[skip-list-iterate-first
|
||||
(-> skip-list? (or/c skip-list-iter? #f))]
|
||||
[skip-list-iterate-next
|
||||
|
|
@ -370,10 +474,8 @@ Levels are indexed starting at 1, as in the paper.
|
|||
[skip-list-iterate-max
|
||||
(-> skip-list? (or/c skip-list-iter? #f))]
|
||||
|
||||
[skip-list-iterate-set-key!
|
||||
(->i ([s skip-list?] [i skip-list-iter?] [k (s) (key-c s)]) [_ void?])]
|
||||
[skip-list-iterate-set-value!
|
||||
(->i ([s skip-list?] [i skip-list-iter?] [v (s) (val-c s)]) [_ void?])]
|
||||
|
||||
[skip-list-iter?
|
||||
(-> any/c any)])
|
||||
(-> any/c any)]
|
||||
|
||||
[skip-list->list
|
||||
(-> skip-list? list?)])
|
||||
|
|
|
|||
|
|
@ -105,7 +105,7 @@
|
|||
invalidate-bitmap-cache)
|
||||
|
||||
;; interval-map of Drawings
|
||||
(define drawings-list (make-numeric-interval-map))
|
||||
(define drawings-list (make-interval-map))
|
||||
|
||||
(field [hover-position #f])
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user