public
Created

A sparse-set implementation in Guile

  • Download Gist
sparse-sets.scm
Scheme
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
;;; Solution to a Programming Praxis task
;;; see http://programmingpraxis.com/2012/03/09/sparse-sets/
 
 
(define-module (programming-praxis sparse-sets)
#:use-module (srfi srfi-9)
#:export (make-sparse-set sparse-set-clear!
sparse-set-member?
sparse-set-add! sparse-set-remove!
sparse-set-for-each)
)
 
(define-record-type sparse-set
(%make-sparse-set len dense sparse)
sparse-set?
(len sparse-set-len sparse-set-len-set!)
(dense sparse-set-dense)
(sparse sparse-set-sparse))
 
 
(define (make-sparse-set universe)
(%make-sparse-set
0
(make-vector universe 0)
(make-vector universe 0)))
 
(define (sparse-set-sparse-ref set n)
(vector-ref (sparse-set-sparse set) n))
 
(define (sparse-set-sparse-set! set n x)
(vector-set! (sparse-set-sparse set)
n
x))
 
(define (sparse-set-dense-ref set n)
(vector-ref (sparse-set-dense set) n))
 
(define (sparse-set-dense-set! set n x)
(vector-set! (sparse-set-dense set)
n
x))
 
(define (sparse-set-universe set)
(vector-length (sparse-set-sparse set)))
 
 
 
 
(define (sparse-set-clear! set)
(sparse-set-len-set! set 0)
set)
 
(define (sparse-set-member? set elem)
(if (>= elem (sparse-set-universe set))
(scm-error 'wrong-type-arg
'sparse-set-add!
"~S not in universe"
(list elem)
#f))
(let* ((dense-pos (sparse-set-sparse-ref set elem))
(sparse-pos (sparse-set-dense-ref set dense-pos)))
(and (< dense-pos (sparse-set-len set))
(= sparse-pos elem))))
 
(define (sparse-set-add! set elem)
(if (>= elem (sparse-set-universe set))
(scm-error 'wrong-type-arg
'sparse-set-add!
"~S not in universe"
(list elem)
#f))
(if (not (sparse-set-member? set elem))
(let ((pos (sparse-set-len set)))
(sparse-set-len-set! set (1+ pos))
(sparse-set-dense-set! set pos elem)
(sparse-set-sparse-set! set elem pos)))
set)
 
(define (sparse-set-remove! set elem)
(if (>= elem (sparse-set-universe set))
(scm-error 'wrong-type-arg
'sparse-set-add!
"~S not in universe"
(list elem)
#f))
(if (sparse-set-member? set elem)
(let ((dense-pos (sparse-set-sparse-ref set elem))
(last-elem (sparse-set-dense-ref set (1- (sparse-set-len set)))))
(sparse-set-dense-set! set dense-pos last-elem)
(sparse-set-sparse-set! set last-elem dense-pos)
(sparse-set-len-set! set (1- (sparse-set-len set)))))
set)
 
(define (sparse-set-for-each proc set)
(let ((len (sparse-set-len set)))
(do ((i 0 (1+ i)))
((= i len))
(proc (sparse-set-dense-ref set i)))))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.