;********************************************************************************************
;  written by:	Charles Poteet
;  date:	9/15/1999
;  file name:	322Lab1.txt
; 
;  purpose:     Fufills the requirements of CSCI 322 (AI Programming) Lab1
;               Provides test set definitions and a test harness
;
;  defines:	MYUNION		- returns union of 2 given lists
;		MYINTERSECTION	- returns intersection of 2 given lists
;		  build-myintersection
;		LDIFFERENCE	- returns ldifference of 2 given lists
;		  build-ldifference
;		INTERSECTP	- predicate to test for intersection
;		SAMESETP	- predicate to test for same set
;		LabTest		- test function that tests all above functions with 1 pair of sets
;		  labtestgo
;		  NotListMsg
;
;		1a 1b through 11a 11b	- 11 pairs of test sets defined
;
;  executes:	on load runs test program for all 11 pairs
;
;  sample output for 1 pair:
; 	(*** LAB1 TEST ***) 
;	(TEST SET 1 (((C)) (A) B)) 
;	(TEST SET 2 ((A) B ((C)))) 
;	(UNION IS ((A) B ((C)))) 
;	(INTERSECTION IS (((C)) B (A))) 
;	(LDIFFERENCE IS NIL) 
;	(INTERSECTP RETURNS T) 
;	(SAMESETP RETURNS T) 
;	(*** TEST COMPLETE ***) 
;	(---------------------) 


;********************************************************************************************
;  function name:  MYUNION  
;  purpose:        Returns the UNION of two sets.  The union of two sets is a set
;                     containing all the elements that are in either of the two sets.
;  preconditions:  function is called with two arguments, both of which should
;                     be sets.
;  postconditions: returns a set

(defun myunion
    (set1 set2)
        (cond ((null set1)          ;if set 1 is an empty list,
                set2                ; return set2
              )
              ((member(first set1) set2 :test #'equal)  ;if 1st element of set1 is a 
                   (myunion (rest set1) set2)   ; member of set2, recursive call 
              )                                 ; parameters: set1 minus 1st element
                                                ;            set2 unchanged
              (t            ;else 1st element of set1 is not member of set2
                   (myunion (rest set1) (cons (first set1) set2))  ; recursive call	
               )                                ;     parameters: set1 minus 1st element	
         )                                      ;                 1st element from set1
)                                               ;                    and all from set2



;********************************************************************************************
;  function name: MYINTERSECTION
;  purpose: Returns the intersection of two sets.  The intersection of two sets
;           is defined as a set containing only the elements that are in both sets.
;  preconditions: function is called with 2 arguments, both of which should be lists.
;  postconditions:  returns a set
;  uses functions:  myunion  -  returns the UNION of 2 sets
;  processing description:  this is a setup function for the recursive function 
;                           build-myintersection, which actually does the work.
;                           The plan is to test each member of the UNION of the given 
;                           for membership in both set1 and set2, and to move each element
;                           which is a member of both sets to a results set.  This function
;                           sets up the initial conditions for the recursive engine (below)

(defun myintersection
       (set1 set2)
           (build-myintersection 
                  set1
                  set2
                  (myunion set1 set2)
                  ()
            )
)

;********************************************************************************************
;  function name: build-myintersection
;  purpose:  recursive processing engine for function myintersection (above).
;  preconditions: function is called with 4 arguments
;                 set1        - 1st parameter (set) from myintersection
;                 set2        - 2nd parameter (set) from myintersection
;                 test-set    - starts as (myunion set1 set2)
;                               one element tested (popped off) for each call
;                 build-set   - starts as ()
;                               each elements that is member of each set added
;  postconditions:  returns build-set when test set becomes an empty set
;  processing description:  this function checks to see if the first member of test-set
;                     is a member of both set1 and set2.  If it is, it is added to 
;                     build-set, the test element is popped, and the function recursively
;                     calls itself.  If first member of test-set is not a member of both
;                     set1 and set2, then it is not added to build-set, but the test
;                     element is popped and the function recursively calls itself as 
;                     described before. 

(defun build-myintersection
       (set1 set2 test-set build-set)
              (cond ((null test-set)      ;if test-set is empty
                          build-set       ;      return build-set to calling function
                    )
                    ((and (member (first test-set) set1 :test #'equal)  ;if 1st element is a
                          (member (first test-set) set2 :test #'equal);member of both sets
                      )
                          (build-myintersection    ;  recursive call w/ parameters
                              set1                 ;     - original 1st set
                              set2                 ;     - original 2nd set 
                              (rest test-set)      ;     - minus tested element
                              (cons (first test-set) build-set) ;add tested element
                           )
                    )
                    (t                          ;else condition - 1st element of test 
                                                ;       set not a member of both sets
                          (build-myintersection ; recursive call
                              set1              ;     - original 1st set
                              set2              ;     - original 2nd set 
                              (rest test-set)   ;     - minus tested element
                              build-set         ;     - didn't add tested element
                          )
                    )
              )
)


;********************************************************************************************
;  function name: LDIFFERENCE
;  purpose: Returns the LDIFFERENCE of two sets.  The ldifference of two sets Inset and OUTset
;           is defined as what remains of the Inset after all the elements that are also 
;           elements of the OUTset are removed.
;  preconditions: function is called with 2 arguments, both of which must be sets
;  postconditions: returns a set
;  uses functions: build-ldifference (defined below)
;  processing description:    this is a setup function for the recursive function
;                             build-ldifference.  The plan is to use in-set as a test set,
;                             testing each element in turn for membership in out-set.  When
;                             the test element is not a member of out-set, it is added to
;                             the result set.  In either case the test element is discarded
;                             on the next recursive call.  In this manner the processing
;                             builds the LDIFFERENCE set, exiting and returning the result set
;                             when the function is called with an empty test-set

(defun ldifference
        (in-set out-set)
                (build-ldifference    ;initial call to recursive function
                     in-set           ;  caught as test-test
                     out-set          ;    caught as set2 - doesn't change during processing
                     ()               ;    caught as build-set
        )
)


;********************************************************************************************
;  function name: build-ldifference
;  purpose:  recursive processing engine for function LDIFFERENCE (above).  
;            This function adds the 1st element of the test set (test element)
;            to build-set if it belongs there (see processing description below).
;  preconditions: function is called with 3 arguments
;                      test-set  - contains remaining elements to be tested
;                                  as each element is tested, is is popped in next call
;                      set2      - 2nd parameter (set) from ldifference
;                      build-set - starts as ()
;                                  each element of test-set that is a member of set2 added
;  postconditons:  returns build-set when test set is empty set
;  processing description:  this function checks to see if the first member of test-set
;                     is a member of set2.  If it not, it is added to the build-set on the
;                     next recursive call.  The build-set does not change if the test element
;                     is in set2.  In both cases, the test element is popped off on the 
;                     next recursive call.  The function returns the build-set when it is
;                     called with a empty test-set.

(defun build-ldifference
        (test-set set2 build-set)
             (cond ((null test-set)       ;if test-set is empty
                       build-set          ;  return build-set to calling function
                   )
                   ((member (first test-set) set2 :test #'equal)  ;if test element is 
                      (build-ldifference              ; a member of set2, recursive call:
                              (rest test-set)         ;     pop test element
                              set2                    ;     comparison set doesn't change
                              build-set               ;     build-set doesn't change
                      )
                   )
                  (t                                  ;else test element NOT member of set2
                        (build-ldifference            ;  recursive call:
                              (rest test-set)         ;     pop test element
                              set2                    ;     comparison set doesn't change 
                              (cons (first test-set) build-set)   ; add test element to 
                        )                                         ;   build-set
                  )
             )
)


;********************************************************************************************
;  function name: SAMESETP
;  purpose:  defines predicate which tests whether two sets contain the same elements
;            the two list representing the sets may be arranged in different orders
;  preconditions: function is called with 2 arguments
;                       set1
;                       set2
;  uses functions: myunion 
;  postconditons:  returns t (true) or nil (false)
;  processing description: this procedure compares the union of the two sets to the length
;                          of each of the sets.  If all lengths are equal, the sets are equal.

(defun samesetp
        (set1 set2)
            (if 
               (and
                    (= (length (myunion set1 set2))
                       (length set1)
                    )

                    (= (length (myunion set1 set2))
                       (length set2)
                    )
               )
                        t           ;true condition returns t
                        nil         ;false condition returns nil
            )
)

;********************************************************************************************
;  function name: INTERSECTP
;  purpose:       Defines intersectp, a predicate that tests whether two sets have any
;                  elements in common.
;  preconditions: function is called with 2 arguments
;                       set1
;                       set2
;  postconditons: returns t or nil
;  processing description:    This function is a wrapper for the function myintersection,
;                             which returns a set of the common elements in both sets.
;                             This function uses myintersection and tests the 
;                             returned set, returning nil if the set is empty, and t
;                             if the set has at least one element.

(defun intersectp
        (set1 set2)
              (not (equal nil
                      (myintersection set1 set2)
                   )
              )
)

;************************************************************
;     Function name: Labtest
;     This program was written to test CSCI 322 Lab1 functions
;     The usage and output for this program are shown below
;
;     [1] USER(11): (labtest 1a 1b)
;
;     (*** LAB1 TEST ***) 
;     (TEST SET 1 ((A) B)) 
;     (TEST SET 2 (A)) 
;     (UNION IS (B (A) A)) 
;     (INTERSECTION IS NIL) 
;     (LDIFFERENCE IS (B (A))) 
;     (INTERSECTP RETURNS NIL) 
;     (SAMESETP RETURNS NIL) 
;     (*** TEST COMPLETE ***)
;     [1] USER(12): 
;
;     This program is accompanied by a 11 test set definintions
;     which defines the 11 pairs of test sets as 1a 1b through 11a 11b.  
;     This program will only test one pair at a time.

(defun Labtest
       (set1 set2)
             (if (and (listp set1)	;Both sets lists?
                      (listp set2)
                 )
                    (Labtestgo set1 set2)  ;True  - run test
                    (NotListMsg set1 set2) ;False - print error message
             )
)

;************************************************************
;
;  Function name:  Labtestgo
;  Purpose:        Runs pair of test sets through all required functions
;                   for lab1.
;  Called by:      LABTEST
;  Uses:           MYUNION
;                  MYINTERSECTION
;                  LDIFFERENCE
;                  INTERSECTP
;                  SAMESETP
;  Assumes:        Both sets are lists (tested by calling function)

(defun Labtestgo
       (set1 set2)
            (print '(*** Lab1 Test ***))
            (print (append  '(Test set 1) 
                        (list set1)
                   )
            )
            (print (append  '(Test set 2) 
                        (list set2)
                   )
            )
            (print (append  '(Union is)
                        (list (myunion set1 set2))
                   )
            )
            (print (append  '(Intersection is)
                        (list (myintersection set1 set2))
                   )
            )
            (print (append  '(LDifference is)
                        (list (ldifference set1 set2))
                   )
            )
            (print (append  '(Intersectp returns)
                        (list (intersectp set1 set2))
                   )
            )
            (print (append  '(Samesetp returns)
                        (list (samesetp set1 set2))
                   )
            )

       (print '(*** test complete ***))
       (print '(---------------------))
)


;************************************************************
;  Function Name: NotListMsg
;  Purpose:       Handles error for test program 
;		  Case: if one or both of the 2
;                       test sets is not a list
;  Called by:  LABTEST

(defun NotListMsg
      (set1 set2)
            (print '(*** Lab1 Test ***))
            (print '(****  ERROR! ****))
            (if (listp set1)

                 (print (append  '(Test set 1) 
                             (list set1)
                        )
                 )
            (print '(Test set 1 is not a list))
            )
            (if (listp set2)

                 (print (append  '(Test set 2) 
                             (list set2)
                        )
                 )
            (print '(Test set 2 is not a list))
            )
       (print '(*** test complete ***))
       (print '(---------------------))
)

;***************************************************************************
;
;  This portion of the code defines the test sets for Lab1 and assigns the
;  lists to symbols: 1a 1b is the first pair of sets, 2a 2b is the second 
;  set, ... and so on to the last pair of sets. 11a and 11b.
;

(setf 1a '((a) b)
      1b '(a)

      2a '((a) b)
      2b '((a))

      3a '(a)
      3b '()

      4a '()
      4b '()

      5a '()
      5b '( d)

      6a '(a)
      6b '(a)

      7a '((a) b)
      7b '(((a)))

      8a '((a b) a b)
      8b '( ((ab)) )

      9a '( ((c)) (a) b)
      9b '( (a) b ((c)) )

      10a 'a
      10b '(a)

      11a '(I (sue) went to the store)
      11b '(joe jim sue)
)


;***************************************************************************
;
;  This portion of the code consists of 11 calls to the test program, each
;  with the appropriate symbols defining the test sets as parameters.  When 
;  this file is loaded, this portion of the code will run all test sets through 
;  all of the required functions, leaving the output on the lisp console without
;  further user action.

(labtest 1a 1b)
(labtest 2a 2b)
(labtest 3a 3b)
(labtest 4a 4b)
(labtest 5a 5b)
(labtest 6a 6b)
(labtest 7a 7b)
(labtest 8a 8b)
(labtest 9a 9b)
(labtest 10a 10b)
(labtest 11a 11b)