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

fix gvector shrinking condition

Browse Source
This commit is contained in:
Ryan Culpepper 2014-11-19 14:16:40 -05:00
parent 5ac4ab32b7
commit a067dcacb0
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/data-pkgs/data-lib/data/gvector.rkt
View File

@ -57,15 +57,22 @@
(set-gvector-vec! gv nv) (set-gvector-vec! gv nv)
(set-gvector-n! gv (+ n item-count)))]))) (set-gvector-n! gv (+ n item-count)))])))
;; Shrink when vector length is > SHRINK-ON-FACTOR * #elements
(define SHRINK-ON-FACTOR 3)
;; ... unless it would shrink to less than SHRINK-MIN
(define SHRINK-MIN 10) (define SHRINK-MIN 10)
;; Shrink by SHRINK-BY-FACTOR
(define SHRINK-BY-FACTOR 2)
;; SLOW! ;; SLOW!
(define (gvector-remove! gv index) (define (gvector-remove! gv index)
(let ([n (gvector-n gv)] (let ([n (gvector-n gv)]
[v (gvector-vec gv)]) [v (gvector-vec gv)])
(check-index 'gvector-remove! index n #f) (check-index 'gvector-remove! index n #f)
(cond [(<= SHRINK-MIN (* 3 n) (vector-length v)) (cond [(and (>= (vector-length v) (* SHRINK-ON-FACTOR n))
(let ([nv (make-vector (floor (/ (vector-length v) 2)) #f)]) (>= (quotient (vector-length v) SHRINK-BY-FACTOR) SHRINK-MIN))
(let ([nv (make-vector (max SHRINK-MIN (quotient (vector-length v) SHRINK-BY-FACTOR)) #f)])
(vector-copy! nv 0 v 0 index) (vector-copy! nv 0 v 0 index)
(vector-copy! nv index v (add1 index) n) (vector-copy! nv index v (add1 index) n)
(set-gvector-n! gv (sub1 n)) (set-gvector-n! gv (sub1 n))
@ -80,8 +87,7 @@
[v (gvector-vec gv)]) [v (gvector-vec gv)])
(check-nonempty 'gvector-remove-last! n) (check-nonempty 'gvector-remove-last! n)
(define last-val (vector-ref v (sub1 n))) (define last-val (vector-ref v (sub1 n)))
(set-gvector-n! gv (sub1 n)) (gvector-remove! gv (sub1 n))
(vector-set! v (sub1 n) #f)
last-val)) last-val))

7
pkgs/data-pkgs/data-test/tests/data/gvector.rkt
View File

@ -161,3 +161,10 @@
(check-pred gvector? g) (check-pred gvector? g)
(for ([i 100]) (for ([i 100])
(check-equal? (gvector-ref g i) i)))) (check-equal? (gvector-ref g i) i))))
(test-case "gvector remove all, shrinks"
(let ([g (make-gvector)])
(for ([i 100]) (gvector-add! g i))
(for ([i 100])
(gvector-remove-last! g))
(check-equal? g (gvector))))