;; CS101 Set Manipulation Procedures:	

(define set-tag "set")

(define the-empty-set (cons set-tag '()))

(define empty-set?
  (lambda (s) (equal? s the-empty-set)))

(define set?
  (lambda (arg)
    (and (pair? arg) (equal? (car arg) set-tag))))

(define compose
  (lambda (f g)
    (lambda (itm) (f (g itm)))))

(define pick
  (lambda (s)
    (let ((lst (cdr s)))
      (if (null? lst)
          (error "pick:  The set is empty.")
          (list-ref lst (random (length lst)))))))

(define residue
  (lambda (e)
    (lambda (s)
      (let ((lst (remove-all e (cdr s))))
        (if (null? lst)
            the-empty-set
            (cons set-tag lst))))))

(define adjoin
  (lambda (e s)
    (cons set-tag (cons e (cdr s)))))

(define cardinal
  (lambda (s)
    (if (empty-set? s)
        0
        (let ((e (pick s)))
          (+ 1 (cardinal ((residue e) s)))))))

(define both
  (lambda (p)
    (lambda (arg1 arg2)
      (and (p arg1) (p arg2)))))

(define neither
  (lambda (p)
    (lambda (arg1 arg2)
      (not (or (p arg1) (p arg2))))))

(define at-least-one
  (lambda (p)
    (lambda (arg1 arg2)
      (or (p arg1) (p arg2)))))

(define make-set
  (lambda args
    (letrec ((list-make-set 
              (lambda (arg-lst)
                (if (null? arg-lst)
                    the-empty-set
                    (adjoin
                     (car arg-lst)
                     (list-make-set (cdr arg-lst)))))))
      (list-make-set args))))

(define none
  (lambda (p)
    (letrec ((test 
              (lambda (s)
                (or (empty-set? s)
                    (let ((e (pick s)))
                      (and (not (p e))
                           (test ((residue e) s))))))))
      test)))

(define there-exists
  (lambda (p) 
    (lambda (s)
      (not ((none p) s)))))

(define for-all
  (lambda (p) (none (compose not p))))

(define superset
  (lambda (s1)
    (lambda (s2)
      ((for-all (contains s1)) s2))))

(define subset
  (lambda (s1)
    (lambda (s2)
      ((superset s2) s1))))

(define set-equal
  (lambda (o1)
    (lambda (o2)
      (or (and ((neither set?) o1 o2) 
               (equal? o1 o2))
          (and ((both set?) o1 o2) 
               ((subset o1) o2) 
               ((subset o2) o1))))))
                          
(define element 
  (compose there-exists set-equal))

(define contains
  (lambda (s)
    (lambda (obj)
      ((element obj) s))))

(define intersection
  (lambda (s1 s2)
    (letrec ((helper
              (lambda (s1)
                (if (empty-set? s1)
                    the-empty-set
                    (let ((e (pick s1)))
                      (if ((contains s2) e)
                          (adjoin e (helper ((residue e) s1)))
                          (helper ((residue e) s1))))))))
      (helper s1))))

(define union
  (lambda (s1 s2)
    (letrec ((helper 
              (lambda (s1)
                (if (empty-set? s1)
                    s2
                    (let ((e (pick s1)))
                      (if (not ((contains s2) e))
                          (adjoin e (helper ((residue e) s1)))
                          (helper ((residue e) s1))))))))
      (helper s1))))

(define difference
  (lambda (s1 s2)
    (letrec ((helper
              (lambda (s1)
                (if (empty-set? s1)
                    the-empty-set
                    (let ((e (pick s1)))
                      (if (not ((contains s2) e))
                          (adjoin e (helper ((residue e) s1)))
                          (helper ((residue e) s1))))))))
      (helper s1))))

(define set-map
  (lambda (fn s)
    (if (empty-set? s)
        the-empty-set
        (let ((e (pick s)))
          (adjoin (fn e)
                  (set-map fn ((residue e) s)))))))

(define remove-all
  (lambda (item lst)
    (cond ((null? lst) '())
	  ((equal? (car lst) item) (remove-all item (cdr lst)))
	  (else (cons (car lst) (remove-all item (cdr lst)))))))

(define make-op
  (lambda (x y) (list x y)))

(define op-1st
  (lambda (op) (car op)))

(define op-2nd
  (lambda (op) (cadr op)))

(define cartesian-product
  (lambda (s1 s2)
     (if (empty-set? s1)
	 the-empty-set
       (let ((e (pick s1)))
       (let ((rest ((residue e) s1)))
	 (union (set-map (lambda (x) (make-op e x)) s2)
		(cartesian-product rest s2)))))))

(define power-set
  (lambda (s)
    (if (empty-set? s)
        (make-set the-empty-set)
      (let ((e (pick s)))
       (let ((new (power-set ((residue e) s))))
        (union new
               (set-map (lambda (s) (adjoin e s))
                        new)))))))	

(define set-comprehension
  (lambda (set p?)
    (if (empty-set? set)
        the-empty-set
	(let ((e (pick set)))
	(let ((rest ((residue e) set)))
	  (if (p? e)
	      (adjoin e (set-comprehension rest p?))
	    (set-comprehension rest p?)))))))

(define subsets-of-size
  (lambda (set n)
    (cond ((= n 0) (make-set the-empty-set))
	  ((empty-set? set) the-empty-set)
	  (else (let ((e (pick set)))
		  (let ((new1 (subsets-of-size ((residue e) set) n))
			(new2 (subsets-of-size ((residue e) set) (- n 1))))
		    (union new1
			   (set-map (lambda (s) (adjoin e s))
				    new2))))))))


(define domain  (lambda (relation) (set-map op-1st relation)))
(define range (lambda (relation) (set-map op-2nd relation)))
	
(define inverse
  (lambda (r)
    (set-map (lambda (op) (make-op (op-2nd op) (op-1st op)))
	     r)))


(define value
  (lambda (x) 
    (lambda (relation)
      (pick (image x relation)))))

(define image
  (lambda (x relation)
    (set-map op-2nd
	     (set-comprehension relation
				(lambda (op)
				  (equal? (op-1st op) x))))))


(define inverse-value
  (lambda (x) 
    (lambda (relation)
      (pick (inverse-image x relation)))))

(define inverse-image
  (lambda (x relation)
    (set-map op-1st
	     (set-comprehension relation
				(lambda (op)
				  (equal? (op-2nd op) x))))))

(define compose-relations
  (lambda (q r)
    (set-map (lambda (op)
	       (make-op (op-1st (op-1st op))
			(op-2nd (op-2nd op))))
	     (set-comprehension (cartesian-product q r)
				(lambda (op)
				  (equal? (op-2nd (op-1st op))
					  (op-1st (op-2nd op))))))))