subset?

This is a predicate taking two sets as arguments. It returns true if $A \subset B, A \neq B$. Subset is important because it provides the mechanism for ``typechecking'' category inheritance in the new Sol category scheme^2.2.

(define subset?
(function
boolean ((a sset) (b sset))

; First, test to see if a and
; b are the same. This check
; obviates the necessity of
; making this comparison for
; all the other cases, and
; could be turned off to
; create a PROPER-SUBSET?
; operator.

(if (eq? a b)
; They are - return true.
(return #t))

; Check to see if B is Sol.
; If it is, return true.

(if (eq? b sol)
(return #t))

;; More compilated checking is now required. Begin by creating an
;; internal recursive procedure for testing each member of a list for
;; membership in a set.

(letrec

; Define an internal recursive
; procedure for testing each
; memeber of a list A for
; membership in a set THE-SET.
((test-contents
(lambda (whats-left the-set)
(cond

; If whats-left is empty, that
; means every element of B was
; a member. Return true

((null? whats-left)
#t)

; If the car of whats-left is in B...

((in? (car whats-left) the-set)
(test-contents (cdr whats-left) the-set))

; Otherwise false.

(else #f)))))


;; Now that the procedure is defined, consider the various cases. The
;; approach used here is to examine the type of sets and make
;; decisions on a case-by-case basis.

(cond ((core? a)

;; Consider the cases where A is a core set.

(if
(core? b)

;; Both A and B are core sets.


; Both sets are core sets, but
; not the same.
; Some core sets are subsets of
; others, so make comparisons
; on case-by-case basis.

(case b
((sol) (return #t)) ; Every core set is a subset of SOL.

; All core sets are subsets of SSET.
((sset)
(case a
((sordered unordered
fundamental core explicit derived
number complex real rational integer
sstring symbol char
pair slist
procedure
boolean) #t)
(else #f)))

; Use the ORDERED? operator to
; decide if a core set is an
; ordered set.

((sordered) (return (ordered? a)))

; The complament (with respect
; to the core sets) of the
; ordered sets is the
; unordered sets.

((unordered) (return (not (ordered? a))))

; CORE is a subset of fundamental.

((fundamental)
(case a
((core) #t)))

; Every number set is a
; subset of NUMBER.
((number)
(case a
((complex real rational integer) (return #t))
(else (return #f))))

; Every number set except
; NUMBER is a subset of
; COMPLEX.

((complex)
(case a
((real rational integer) (return #t))
(else (return #f))))

; RATIONAL and INTEGER
; are proper subsets of REAL.

((real)
(case a
((rational integer) (return #t))
(else (return #f))))
((rational)

; INTEGER is a proper subset
; of RATIONAL.

(case a
((integer) (return #t))
(else (return #f))))

; LIST is a proper subset of PAIR.
((pair)
(case a
((slist) (return #t))
(else (return #f))))

; INTEGER, SSTRING, SYMBOL,
; CHAR, PROCEDURE, AND BOOLEAN
; have no proper subsets among
; the core classes.

((explicit derived
integer
sstring symbol char
unordered
slist
procedure
boolean)
(return #f)))


; The only way A can be a
; subset of B if A is core is
; if B is also core.
; Therefor, return false.

(return #f)))

;; Done with the first cond clause.
;; A isn't a core set. Check to see if it is a fundamental set.

((explicit? a)

; A is an explicit
; user-defined set.

((fundamental? b)

; A is explicit user-defined
; and B is a fundamental set,
; meaning that it could be
; core or explicit.


; Make a into a list and
; assign the results to
; CONTENTS.

(let ((contents (set->list a)))

; We have to explicitly check
; for the empty set condition,
; because TEST-CONTENTS won't
; detect it.

(if (null? contents)
(return (in? a b))


; Return the results of
; calling TEST-CONTENTS on the
; contents of A and B.

(return (test-contents contents b)))))

;; A is explicit - is B derived?

((derived? b)

; A is explicit, user-defined
; and B is derived. Most of
; the cases will involve
; recursively calling SUBSET?
; to get the answer.

; Assign some conveneint variables.

(letrec ((operation (car b))
(operand1 (cadr b))
(operand2 (caddr b)))

; Check for different
; operation types.

(case operation

; If the operation is union...

((union)
(return
(or (subset? a operand1) (subset? a operand2))))

; Intersection...

((intersection)

; *** This isn't always true.
; The intersection could be
; the empty set, which may not
; be a member of B. Likewise,
; neither set may be a subset
; of B, but the intersection
; certainly could be. I will
; have to fix this in the
; future.

(return
(and (subset? a operand1) (subset? a operand2))))

; Difference.

((difference)

; If operand1 is a subset of
; operand2, the difference is
; the empty set. Check for
; this condition, and return
; true in this case only if
; the empty set is a subset of
; operand 2.

(if (subset? operand1 operand2)
(return (subset? a (set)))

; Operand1 is not a subset of
; operand2. Therefor,
; operand1 - operand2 will
; leave some elements of
; operand 1.

(return (subset? a operand1))))

; Check for a cartesian product.

((cross)

; Check every member of A for
; membership in B. Return
; true if all are members.

(let ((contents (set->list a)))

; We have to explicitly check
; for the empty set condition,
; because TEST-CONTENTS won't
; detect it.

(if (null? contents)
(return (in? a b))

; Return the results of
; calling TEST-CONTENTS on the
; contents of A and B.

(return (test-contents contents b)))))

; Error - operation must be
; union, intersection or
; difference.

(else (error "subset?: Bad derived set:" b))))))


;; Is A a derived set?

((derived? a)
; A is a derived set.
; Recursively call subset? in
; the appropriate
; combinations.

(letrec ((operation (car a))
(operand1 (cadr a))
(operand2 (caddr a)))

(case operation

; If the operation is union...

((union)
(return
(and (subset? operand1 b) (subset? operand2 b))))

; Intersection...

((intersection)

; *** This isn't always true.
; The intersection could be
; the empty set, which may not
; be a member of B. Likewise,
; neither set may be a subset
; of B, but the intersection
; certainly could be. I will
; have to fix this in the
; future.

(return
(and (subset? operand1 b) (subset? operand2 b))))

; Difference.

((eq? operation 'difference)

; If operand1 is a subset of
; operand2, the difference is
; the empty set. Check for
; this condition, and return
; true in this case only if
; the empty set is a subset of
; operand 2.

(if (subset? operand1 operand2)
(return (subset? (set) b))

; Operand1 is not a subset of
; operand2. Therefor,
; operand1 - operand2 will
; leave some elements of
; operand 1.

(return (subset? operand1 b))))

; Error - operation must be
; union, intersection or
; difference.

(else (error "subset?: Bad derived set:" a)))))

; A is not a set, so it cannot
; possibly be a subset of B.

(else (return #f)))))
)