Skip to content

Instantly share code, notes, and snippets.

@keenbug
Created March 10, 2012 11:10
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save keenbug/2011167 to your computer and use it in GitHub Desktop.
A sparse-set implementation in Guile
;;; 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)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment