intersection

intersection is a binary operation producing the intersection of two sets.

This implementation of intersection is incomplete, as it only simplifies in the case where both sets are explicit. A significant expansion will be required to get this working in the more general case.

(define intersection
(function metaset ((obj1 metaset)
(obj2 metaset))
(cond

; If both objects are the
; same, return the first set.
((eq? obj1 obj2)
obj1)

; If either OBJ1 or OBJ2 are
; SOL, return the other
; object.

((eq? obj1 sol)
obj2)

((eq? obj2 sol)
obj1)

; Now check the first object
; against the core sets.

((core? obj1)
; OBJ1 is a member of CORE.
(cond
((core? obj2)

;; We know that both OBJ1 and OBJ2 are core. This section is devoted
;; to case-by-case matching for simplification.

(case obj1
((sset)
(case obj2

; The intersection of SSET an
; any other set-containing set
; B is set B.

((sordered unordered
fundamental core explicit derived) obj2)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is SORDERED
((sordered)
(case obj2

; The intersection of SSET and
; SORDERED results in SORDERED.

((sset) sordered)
(else (list 'intersection obj1 obj2))))

((unordered)
(case obj2

; The intersection of SSET and
; UNORDERED results in UNORDERED.

((sset) unordered)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is FUNDAMENTAL

((fundamental)
(case obj2

; The intersection of FUNDAMENTAL and
; DERIVED is empty.

((sset derived) '(set ))

; CORE and EXPLICIT are
; subsets of FUNDAMENTAL.

((core explicit) obj2)
(else (list 'intersection obj1 obj2))))

; OBJ1 is CORE

((core)
(if (core? obj2)
obj2
(list 'intersection obj1 obj2)))

; There are no CORE sets
; (other than themselves)
; which have non-empty
; intersections with EXPLICIT
; and DERIVED.

((explicit derived)
'(set ))

; If OBJ1 is NUMBER

((number)
(case obj2
((complex real rational integer) obj2)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is COMPLEX
((complex)
(case obj2
((number) complex)
((real rational integer) obj2)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is REAL
((real)
(case obj2
((number complex) 'real)
((rational integer) obj2)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is RATIONAL
((rational)
(case obj2
((number complex real) 'rational)
((integer) 'integer)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is INTEGER
((integer)
(case obj2
((number complex real rational) 'integer)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is SSTRING,
; SYMBOL, or CHAR

((sstring symbol char)
(list 'intersection obj1 obj2))

; If OBJ1 is PAIR

((pair)
(case obj2
((slist) 'slist)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is SLIST

((slist)
(case obj2
((pair) 'slist)
(else (list 'intersection obj1 obj2))))

; If OBJ1 is PROCEDURE or BOOLEAN

((procedure boolean)
(list 'intersection obj1 obj2))))

;; ------Begin current edits

;; In this section we deal with the case of OBJ1 being a core set and
;; OBJ2 being an explicit set. Basically, we call
;; intersection-core-explicit and be done with it.

((explicit? obj2)

; OBJ1 is CORE, and OBJ2 is
; EXPLICIT.

(let ((val2 (set->list obj2)))

; Call
; intersection-core-explicit.

(let ((result (intersection-core-explicit obj1 val2 '())))
(if (null? result)
; There were no elements in common.

(set )

; If both are ordered...

(if (and (ordered? obj1) (ordered? obj2))

; Make the result an ordered set.
(list->ordered result)

; One or both are not ordered.
; Make the result unordered.

(list 'union obj1
(list->unordered
(union-core-explicit
obj1 val2 '()))))))))

;; ------End current edits

((and (explicit? obj1) (explicit? obj2))
(letrec
((val1 (set->list obj1))
(val2 (set->list obj2))
(internal ; Define an internal recursive
; procedure.
(lambda (a b intersect)

; A and B are lists containing
; the members of the input
; sets, and INTERSECT is a
; list containing the elements
; of the intersection of the
; two sets. A should be no
; larger than B for optimal
; efficiency.

(if (equal? a '()) ; Is A empty?
; We're done - return intersection.
(cons 'set intersect)

; A not empty. Check to see if
; (car A) in B...

(if (member (car a) b)

; ...it is. Call internal
; with updated INTERSECT list.

(internal (cdr a) b (cons (car a) intersect))

; Otherwise, call with
; original intersect list.

(internal (cdr a) b intersect))))))


; We have defined internal.
; Now, apply it to the
; arguments (which we already
; know are both sets).

; If the length of obj1 is
; greater than the length of
; obj2...

(if (> (length val1) (length val2))

; Put the smaller set first.

(internal val2 val1 '())
(internal val1 val2 '()))))
(else
`(intersection ,obj1 ,obj2)))))
))