;; Utilities

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Set operations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This file defines procedures that manipulate sets, which are
;; implemented as lists of symbols.  The operations implemented are
;;  intersection
;;  union
;;  setdiff
;;  setequal? (a predicate)
;;
;; The order of symbols in a list that represents a set is immaterial.
;; Sets should never contain multiple copies of the same element.
;; All of the above procedures take two or more arguments.  When applied to
;; more than two arguments, the operation is left-associative.
;;
;; This implementation is pretty inefficient, but simple.  More efficient
;; implementations would at least keep set elements sorted, or would use
;; some bit-vector representation to take advantage of fast arithmetic
;; hardware.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Logical operations on lists
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This file also defines predicates every? and some?, which test a given
;; condition on each element of a list.  Every? returns #t if each element
;; satisfies the condition, some? returns #t if any of them does.
;; those is a procedure that, given a list and a condition, returns a new list
;; that contains only those elements in the first list that meet condition.

(define (n-arg proc)
  (define (n-arg-proc list1 . lists)
    (if (null? lists)
      list1
      (apply n-arg-proc
             (proc list1 (car lists))
             (cdr lists))))
  n-arg-proc)

(define (intersection2 l1 l2)
  (define (intersect2 l1 ans)
    (if (null? l1)
      ans
      (intersect2 (cdr l1)
                  (if (memq (car l1) l2)
                    (cons (car l1) ans)
                    ans))))
  (if (null? l2)
    '()
    (intersect2 l1 '())))

(define intersection (n-arg intersection2))

(define (union2 l1 l2)
  (if (null? l1)
    l2
    (union2 (cdr l1)
            (if (memq (car l1) l2)
              l2
              (cons (car l1) l2)))))

(define union (n-arg union2))

(define (setdiff2 l1 l2)
  (define (iter l ans)
    (if (null? l)
      ans
      (iter (cdr l)
            (if (memq (car l) l2)
              ans
              (cons (car l) ans)))))
  (iter l1 '()))

(define setdiff (n-arg setdiff2))

(define (setequal2 l1 l2)
  (and (= (length l1) (length l2))
       (null? (setdiff2 l1 l2))))

(define setequal? (n-arg setequal2))

(define (subset? l1 l2)
  (every? l1 (lambda (x) (memq x l2))))

(define make-set list)

(define cardinality length)

(define empty-set '())

(define empty? null?)

(define (every? l fn)
  (if (null? l)
    #t
    (if (fn (car l))
      (every? (cdr l) fn)
      #f)))

(define (some? l fn)
  (if (null? l)
    #f
    (or (fn (car l))
        (some? (cdr l) fn))))

(define (those l pred)
  (define (iter l ans)
    (if (null? l) 
      ans
      (iter (cdr l)
            (if (pred (car l))
              (cons (car l) ans)
              ans))))
  (iter l '()))

(define (dolist l fn)
  ;; Some Schemes define for-each to do the same thing, but with the
  ;; procedure as the first argument.
  (define (iter lis)
    (if (null? lis)
      'done
      (begin (fn (car lis))
             (iter (cdr lis)))))
  (iter l))

(define (dotimes n fn)
  (define (iter i)
    (if (>= i n)
      'done
      (begin (fn i)
             (iter (+ i 1)))))
  (iter 0))

(define (dovector v fn)
  (let ((n (vector-length v)))
    (define (iter i)
      (if (>= i n)
        'done
        (begin (fn (vector-ref v i))
               (iter (+ 1 i)))))
    (iter 0)))

(define (vector-position thing vec)
  ;; Returns the numerical position of thing in vec, or #f if not present.
  (let ((l (vector-length vec)))
    ;; Note that the "named let" construction is the equivalent of defining
    ;; an auxiliary function (whose name is the name) and then calling it
    ;; with the initial values.  This is just a convenient syntactic shortcut,
    ;; and occurs elsewhere in the code as well.
    (let iter ((i 0))
      (if (>= i l)
        #f
        (if (eqv? (vector-ref vec i) thing)
          i
          (iter (+ 1 i)))))))

;;;;;;;;;;;
;;
;; reducer is a higher-order procedure that returns a procedure of one
;; argument, a list.  This, in turn reduces the list according to the args
;; to reducer.
;;  mapper is applied to each successive element of the list
;;  combiner is called with two args, the mapped current element and the prev
;;    result
;;  initial-val is the starting value of the result.
;; For example, (reducer sqrt + 0.0), when applied to a list, will return
;; the sum of the square roots of the elements.  (reducer sqrt cons '())
;; will return the list of square roots.


(define (reducer mapper combiner initial-val)
  (lambda (lis)
    (let inner ((l lis) (ans initial-val))
         (if (null? l)
           ans
           (inner (cdr l) (combiner (mapper (car l)) ans))))))