(define assoc-all
(lambda (key alist)
(cond
; If there are no entries left in the association list,
; there are no entries with the given key.
((null? alist)
())
; If the key we're looking for is the key of the first
; entry, then use that entry.
((equal? key (car (car alist)))
(cons (car alist)
(assoc-all key (cdr alist))))
; Otherwise, look in the rest of the association list.
(else
(assoc-all key (cdr alist))))))
(define people
(list (list "Adams" "Amy" "Architecture")
(list "Jones" "Jack" "Geography")
(list "Jones" "Jane" "Geology")
(list "Smith" "Sarah" "Science")
(list "Jones" "Jenna" "Genetics")))
(define vpeople
(vector (list "Adams" "Amy" "Architecture")
(list "Jones" "Jack" "Geography")
(list "Jones" "Jane" "Geology")
(list "Jones" "Jenna" "Genetics")
(list "Jones" "Jeremiah" "Gerentology")
(list "Jones" "J. Maxwell" "French Horn")
(list "Smith" "Sarah" "Science")
))
;;; Procedure:
;;; binary-search
;;; Parameters:
;;; vec, a vector to search
;;; get-key, a procedure of one parameter that, given a data item,
;;; returns the key of a data item
;;; may-precede?, a binary predicate that tells us whether or not
;;; one key may precede another
;;; key, a key we're looking for
;;; Purpose:
;;; Search vec for a value whose key matches key.
;;; Produces:
;;; match, a number.
;;; Preconditions:
;;; The vector is "sorted". That is,
;;; (may-precede? (get-key (vector-ref vec i))
;;; (get-key (vector-ref vec (+ i 1))))
;;; holds for all reasonable i.
;;; The get-key procedure can be applied to all values in the vector.
;;; The may-precede? procedure can be applied to all pairs of keys
;;; in the vector (and to the supplied key).
;;; The may-precede? procedure is transitive. That is, if
;;; (may-precede? a b) and (may-precede? b c) then it must
;;; be that (may-precede? a c).
;;; If two values are equal, then each may precede the other.
;;; Similarly, if two values may each precede the other, then
;;; the two values are equal.
;;; Postconditions:
;;; If vector contains no element whose key matches key, match is -1.
;;; If vec contains an element whose key equals key, match is the
;;; index of one such value. That is, key is
;;; (get-key (vector-ref vec match))
(define binary-search
(lambda (vec get-key may-precede? key)
; Search a portion of the vector from lower-bound to upper-bound
(let search-portion ((lower-bound 0)
(upper-bound (- (vector-length vec) 1)))
; If the portion is empty
(if (> lower-bound upper-bound)
; Indicate the value cannot be found
-1
; Otherwise, identify the middle point, the element at that
; point and the key of that element.
(let* ((midpoint (quotient (+ lower-bound upper-bound) 2))
(middle-element (vector-ref vec midpoint))
(middle-key (get-key middle-element))
(left? (may-precede? key middle-key))
(right? (may-precede? middle-key key)))
(cond
; If the middle key equals the value, we need to see
; if it's the leftmost value.
((and left? right?)
(if (= lower-bound upper-bound)
midpoint
(search-portion lower-bound midpoint)))
; If the middle key is too large, look in the left half
; of the region.
(left?
(search-portion lower-bound (- midpoint 1)))
; Otherwise, the middle key must be too small, so look
; in the right half of the region.
(else
(search-portion (+ midpoint 1) upper-bound))))))))
;;; Produces:
;;; info, a two element list of the form (sum count)
(define number-tree-info
(let ((COMBINE
(lambda (left-info right-info)
(list (+ (car left-info) (car right-info))
(+ (cadr left-info) (cadr right-info))))))
(lambda (ntree)
(cond
((pair? ntree)
(let ((left-info (number-tree-info (car ntree)))
(right-info (number-tree-info (cdr ntree))))
(list (+ (car left-info) (car right-info))
(+ (cadr left-info) (cadr right-info)))))
((number? ntree)
(list ntree 1))
(else
(error "Boom. Crash."))))))
(define char-shift
(lambda (character amount)
(integer->char (+ amount (char->integer character)))))
(define shift-encoder
(lambda (amount)
(lambda (string)
(list->string (map (r-s char-shift amount) (string->list string))))))
(define poly-term
(lambda (c n)
(lambda (x)
(* c (expt x n)))))
(define polynomial
(lambda (coefs)
(lambda (x)
(apply + (map (lambda (c n) (* c (expt x n))) coefs (iota (length coefs)))))))