;;;========== ;;; Utilities ;;;========== (define (vector-last v) (+ (vector-length v) 1)) (define (vector-swap! v i j) (let ((temp (vector-ref v i))) (vector-set! v i (vector-ref v j)) (vector-set! v j temp))) (define (vector-reverse! v) (do ((first 0 (1+ first)) (last (vector-last v) (-1+ last))) ((>= first last) v) (vector-swap! v first last))) ;;;==================================================== ;;; Vector which only allows storage of improved values ;;;==================================================== (define make-vector-with-predicate (make-encapsulation (n predicate) ((v (make-vector n 'empty))) () ((set!? (lambda (index value) (cond ((or (eqv? (vector-ref v index) 'empty) (predicate value (vector-ref v index))) (vector-set! v index value) #!TRUE) (else #!FALSE)))) (ref (lambda (index) (vector-ref v index))) (values (lambda () v))))) ;@ ;;;================================= ;;; Deque implemented using a vector ;;;================================= (define make-vector-deque (make-encapsulation (n) ((v (make-vector n)) (number-of-nodes 0) (front 0) (rear 0) (last (-1+ n))) ((check-overflow (lambda () (if (full?) (error "deque overflow")))) (check-underflow (lambda () (if (empty?) (error "deque underflow")))) (increase-nodes! (lambda () (check-overflow) (set! number-of-nodes (1+ number-of-nodes)))) (decrease-nodes! (lambda () (check-underflow) (set! number-of-nodes (-1+ number-of-nodes))))) ((full? (lambda () (= number-of-nodes n))) (empty? (lambda () (= number-of-nodes 0))) (in-rear! (lambda (value) (increase-nodes!) (vector-set! v rear value) (set! rear (if (= rear last) 0 (1+ rear))) *the-non-printing-object*)) (in-front! (lambda (value) (increase-nodes!) (set! front (if (= front 0) last (-1+ front))) (vector-set! v front value) *the-non-printing-object*)) (out-front! (lambda () (decrease-nodes!) (let ((temp front)) (set! front (if (= front last) 0 (1+ front))) (vector-ref v temp)))) (out-rear! (lambda () (decrease-nodes!) (set! rear (if (= rear 0) last (-1+ rear))) (vector-ref v rear))) (peek-front (lambda () (check-underflow) (vector-ref v front))) (peek-rear (lambda () (check-underflow) (vector-ref v (if (= rear 0) last (-1+ rear))))) (length (lambda () number-of-nodes))))) ;@ ;;;=============================================== ;;; Deque implemented with a vector-with-predicate ;;;=============================================== (define make-vector-deque-with-values (make-encapsulation (n predicate) ((v (make-vector-with-predicate n predicate)) (queue (make-vector-deque n)) (in-q (make-vector n 'never-was-in))) ((v-set!? (v 'set!?)) (in-front! (queue 'in-front!)) (in-rear! (queue 'in-rear!)) (out-front! (queue 'out-front!))) ((push!? (lambda (index value) (cond ((v-set!? index value) (case (vector-ref in-q index) (never-was-in (in-rear! index)) (was-in (in-front! index))) (vector-set! in-q index 'in) #!TRUE) (else #!FALSE)))) (pop! (lambda () (let ((value (out-front!))) (vector-set! in-q value 'was-in) value))) (v-ref (v 'ref)) (empty? (queue 'empty?))))) ;@ ;;;========================================= ;;; Heap which keeps track of which elements ;;; of a fixed set are currently members. ;;;========================================= (define make-heap-with-membership (make-encapsulation (n predicate) ((v (make-vector n)) (member-v (make-vector n '())) (fill-pointer -1)) ((heap-set! (lambda (index value) (vector-set! v index value) (vector-set! member-v value index))) (sift! (lambda (current step-function value predicate) (let ((next (step-function current))) (cond ((or (null? next) (predicate value (vector-ref v next))) (heap-set! current value)) (else (heap-set! current (vector-ref v next)) (sift! next step-function value predicate)))))) (heap-son (lambda (father) (let ((son (* 2 (1+ father)))) (cond ((>= fill-pointer son) (if (predicate (vector-ref v son) (vector-ref v (-1+ son))) son (-1+ son))) ((= fill-pointer (-1+ son)) (-1+ son)) (else '()))))) (heap-father (lambda (son) (if (>= 0 son) '() (quotient (-1+ son) 2)))) (downheap! (lambda (father value) (sift! father heap-son value predicate))) (upheap! (lambda (son value) (sift! son heap-father value (lambda (x y) (predicate y x)))))) ((empty? (lambda () (= fill-pointer -1))) (push! (lambda (value) (let ((index (vector-ref member-v value))) (cond ((null? index) (set! fill-pointer (1+ fill-pointer)) (upheap! fill-pointer value)) (else (upheap! index value)))))) (pop! (lambda () (let ((temp (vector-ref v 0))) (vector-set! member-v temp '()) (set! fill-pointer (-1+ fill-pointer)) (downheap! 0 (vector-ref v (1+ fill-pointer))) temp)))))) ;@ ;;;======================================= ;;; Heap with membership implemented using ;;; a vector-with predicate. ;;;======================================= (define make-heap-with-membership-and-values (make-encapsulation (n predicate) ((v (make-vector-with-predicate n predicate)) (ref (v 'ref)) (heap (make-heap-with-membership n (lambda (x y) (predicate (ref x) (ref y)))))) ((v-set!? (v 'set!?)) (push! (heap 'push!))) ((push!? (lambda (index value) (cond ((v-set!? index value) (push! index) #!TRUE) (else #!FALSE)))) (pop! (heap 'pop!)) (v-ref ref) (empty? (heap 'empty?)))))