A sparse-set implementation in Guile
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; 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