; These functions represent the top few levels of an implementation
;   of Mitchell's candidate elimination algorithm.  The missing
;   portions are described in the text of Assignment 1.

; These calls are necessary in Dr. Scheme if any tracing is to be done
; If you want to trace, just uncomment them.

;(require-library "trace.ss")
;(require-library "tracec.ss")


; This is the top-level function for the candidate-elimination
;   algorithm.  It checks for the 3 termination conditions G=S,
;   G is empty, and S is empty, and otherwise reads in the next
;   example and updates the version space appropriately, depending
;   on whether the example is positive or negative.

(define (candidate-elimination space)
  (print space) (newline)
  (cond ((finished? (g space) (s space)) (g space))
        ((null? (g space)) (null-error '() (s space)))
        ((null? (s space)) (null-error (g space) '()))
        (else (let ((classified-example (read)))
                (cond ((is-positive? classified-example)
                       (candidate-elimination
                        (update-pos space (example classified-example))))
                      (else
                       (candidate-elimination
                        (update-neg space (example classified-example)))))))))


; The candidate elimination algorithm is finished iff G and S are
;   identical singleton sets (lists of length 1).

(define (finished? g s)
  (and (equal? g s) (= (length g) 1)))

; Print an error message if G or S is empty

(define (null-error g s)
  (print "the data is inconsistent")
  (print "g is")
  (print g)
  (print "s is")
  (print s))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;; Auxiliary functions for the candidate-elimination algorithm ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; To update the version space after a positive example:
;   Delete any elements of G that fail to match the example
;      (i.e., FILTER G, retaining those that do)
;   Replace any elements of S that fail to match the example by
;      those concepts that are maximally specific generalizations
;      (not necessarily immediate generalizations)
;      of the concept, subject to matching the example.
;      This is accomplished by calling SPECUNION.
;      Note that there's a special case if S is empty
;        (if the algorithm is allowed to start with a negative
;         example)

(define (update-pos space unclassified-example)
  (let ((newg (filter
               (lambda (x) (covers? x unclassified-example))
               (g space))))
    (build-version-space
     newg
     (cond ((null? (s space)) (list unclassified-example))
           (else (update+s (s space) '() newg unclassified-example space)))
   (rest space))))

; To update the version space after a negative example:
;   Delete any elements of S that match the example
;      (i.e., FILTER S, retaining those that don't)
;   Replace any elements of G that match the example by
;      those concepts that are maximally general specializations
;      (not necessarily immediate specializations)
;      of the concept, subject to failing to match the example.

(define (update-neg space unclassified-example)
  (let ((news (filter
               (lambda (x) (not (covers? x unclassified-example)))
               (s space))))
    (build-version-space
     (update-g (g space) '() news unclassified-example space)
     news
     (rest space))))


; This predicate succeeds iff the concept X covers any of the concepts
;   in the set SET (represented as a list)

(define (covers-any? x set)
  (cond ((null? set) #f)
        ((covers? x (car set)) #t)
        (else (covers-any? x (cdr set)))))


; This predicate succeeds iff the concept X is covered by any of
;   the concepts in the set SET (represented as a list)

(define (covered-by-any? x set)
  (cond ((null? set) #f)
        ((covers? (car set) x) #t)
        (else (covered-by-any? x (cdr set)))))


; This is the function that replaces any elements of G that match 
;   the example by those concepts that are maximally 
;   general specializations of the concept, subject to failing to 
;   match the example.
; OLDG is a list of the remaining original concepts of G.  NEWG 
;   is a list of the concepts so far contained in the new value of G.
; For each concept in OLDG, it is tentatively passed to NEWG if it 
;   fails to match the example, while its immediate specializations
;   are tentatively passed to NEWG otherwise.  It is EXPAND-G that
;   is responsible for making sure that no concept in G is a 
;   specialization of another, and that each covers some element 
;   of S.  It also is responsible for specializing the specializations
;   if necessary.

(define (update-g oldg newg news unclassified-example space)
  (cond ((null? oldg) newg)
        (else (update-g (cdr oldg)
                        (expand-g
                         (cond ((covers? (car oldg) unclassified-example)
                                (immedspecs (car oldg) space))
                               (else
                                (list (car oldg))))
                                newg
                                news
                                unclassified-example
                                space)
                        news unclassified-example space))))

; EXPAND-G takes a list of PENDING additions to G, and for each one,
;   tests to see whether it fails to cover an element of S (in which
;   case it does not get added to G) and whether it fails to cover 
;   the latest example (in which case it does, modulo the check by
;   ADD-CONCEPT-REMOVING-SPECIALIZATIONS of whether it is a 
;   generalization or a specialization of a concept already in G).
; In the remaining case, the pending concept needs to be specialized
;   further.  The specializations are added to PENDING and the
;   function called recursively.

(define (expand-g pending newg news unclassified-example space)
  (cond ((null? pending) newg)
        ((not (covers-any? (car pending) news))
         (expand-g (cdr pending) newg news unclassified-example space))
        ((not (covers? (car pending) unclassified-example))
         (expand-g (cdr pending)
                   (add-concept-removing-specializations
                    (car pending) newg)
                   news unclassified-example space))
        (else
         (expand-g (append (immedspecs (car pending) space)
                           (cdr pending))
                   newg news unclassified-example space))))

; These two functions are the dual of the previous two functions.

(define (update+s olds news newg unclassified-example space)
  (cond ((null? olds) news)
        (else (update+s (cdr olds)
                        (expand-s
			 (cond ((covers? (car olds) unclassified-example)
				(list (car olds)))
                                (else
				 (immedgenls (car olds) space)))
			 news
			 newg
			 unclassified-example
			 space)
			newg unclassified-example space))))

(define (expand-s pending news newg unclassified-example space)
  (cond ((null? pending) news)
        ((not (covered-by-any? (car pending) newg))
         (expand-s (cdr pending) news newg unclassified-example space))
        ((covers? (car pending) unclassified-example)
         (expand-s (cdr pending)
                   (add-concept-removing-generalizations
                    (car pending) news)
                   newg unclassified-example space))
        (else
         (expand-s (append (immedgenls (car pending) space)
                           (cdr pending))
                   news newg unclassified-example space))))

; Takes a concept and a list of general-concepts, and adds the
;   concept to the list, unless it is a specialization of one
;   of the concepts.  Also removes any concept from the list that
;   is a specialization of the given concept.  Note that
;   (assuming the list of concepts is well-formed) the concept
;   cannot be both a specialization and a generalization of
;   some concepts in the list.

(define (add-concept-removing-specializations concept general-concepts)
  (cond ((null? general-concepts) (list concept))
        ((covers? concept (car general-concepts))
         (add-concept-removing-specializations
          concept
          (cdr general-concepts)))
        ((covers? (car general-concepts) concept) general-concepts)
        (else (cons (car general-concepts)
                    (add-concept-removing-specializations
                     concept
                     (cdr general-concepts))))))


; This is the dual of the above function, for special concepts.

(define (add-concept-removing-generalizations concept special-concepts)
  (cond ((null? special-concepts) (list concept))
        ((covers? (car special-concepts) concept)
         (add-concept-removing-generalizations
          concept
          (cdr special-concepts)))
        ((covers? concept (car special-concepts)) special-concepts)
        (else (cons (car special-concepts)
                    (add-concept-removing-generalizations
                     concept
                     (cdr special-concepts))))))