;;; --------------------------
;;;  CMPU-145, Spring 2013
;;;  Lab 4
;;;  Feb. 25, 2013
;;; --------------------------

(load "asmt-helper.txt")

(header "Lab 4" "Solutions")

;;; --------------------
;;;  GIVEN FUNCTIONS
;;; --------------------

(problem "0:  REFLEXIVE?, SYMMETRIC?, FLATTEN and CARTESIAN-PRODUCT")

(printf "NOTE:  These functions were seen in class~%~%")

;;;  REFLEXIVE?  --  seen in class
;;; ----------------------------------------
;;;  INPUTS:  LIST-O-PAIRS, a list of pairs representing a relation
;;;             over some set A
;;;           THE-SET-A, the set A
;;;  OUTPUT:  #t if the given relation is reflexive; #f otherwise.
;;; ----------------------------------------
;;;  Note:  This function is not terribly efficient, but it illustrates
;;;         the use of DOLIST and a "bit" of destructive programming.

(define reflexive?
  (lambda (list-o-pairs the-set-A)
    ;; ANSWER starts out #t; will turn to #f if we ever find a violation
    ;;  of reflexivity.
    (let ((answer #t))
      ;; Walk through the list THE-SET-A
      (dolist (a the-set-A)
              ;; Check whether (a a) is in the relation
              (if (not (member (list a a) list-o-pairs))
                  ;; if not, change ANSWER to #F
                  (set! answer #f)))
      ;; AFTER the DOLIST finishes, return the ANSWER
      answer)))

(tester '(reflexive? '((1 1) (3 3) (2 2)) '(1 2 3)))
(tester '(reflexive? '((3 3) (1 1) (1 2)) '(1 2 3)))

;;;  SYMMETRIC?  --  seen in class
;;; --------------------------------------------
;;;  INPUTS:  LIST-O-PAIRS, a list of pairs representing a relation
;;;              over some set A
;;;  OUTPUT:  #t if the relation is symmetric; #f otherwise.
;;; --------------------------------------------
;;;  Note that we don't need to know what the set A is to check symmetry.

(define symmetric?
  (lambda (list-o-pairs)
    ;; Same structure as REFLEXIVE?, except that we walk through the
    ;; list of PAIRS, checking each one.
    (let ((answer #t))
      (dolist (pr list-o-pairs)
              ;; Note that if PR = (X Y), then (REVERSE PR) = (Y X)
              ;; If (Y X) not in the relation, then we have a violation
              ;; of symmetry.
              (if (not (member (reverse pr) list-o-pairs))
                  (set! answer #f)))
      ;; AFTER the DOLIST finishes, return the answer
      answer)))

(newline)
(tester '(symmetric? '((1 2) (1 1) (3 2) (2 1) (2 3))))
(tester '(symmetric? '((1 2) (1 1) (3 2) (2 1))))

;;;  FLATTEN  --  seen in class
;;; ---------------------------------------------
;;;  INPUT:  LISTY, a list of lists
;;;  OUTPUT:  A "flattened" version of LISTY formed by concatenating
;;;    all of the sublists in LISTY.

(define flatten
  (lambda (listy)
    ;; Base Case:  LISTY is empty
    (if (null? listy)
        ;; Return the EMPTY list
        ()
        ;; Otherwise, concatenate the first sublist in LISTY to 
        ;; whatever the recursive function call returns
        (append (first listy)
                (flatten (rest listy))))))

(newline)
(tester '(flatten '((1 2) (3) (4 5 6) (7))))

;;;  CARTESIAN-PRODUCT -- seen in class
;;; ------------------------------------------
;;;  INPUT:  LISTY, a list
;;;  OUTPUT:  The cartesian-product LISTY X LISTY
;;;   (i.e., the list of all pairs (a b) where both a and b are in LISTY.

(define cartesian-product
  (lambda (listy)
    ;; This time, ANSWER is an accumulator that accumulates all 
    ;; the wanted pairs
    (let ((answer ()))
      ;; Use NESTED dolists because we want to consider all possible pairs
      ;; of elements from listy
      (dolist (elt1 listy)
              (dolist (elt2 listy)
                      ;; Accumulate the pair (elt1 elt2)
                      (set! answer (cons (list elt1 elt2) answer))))
      ;; AFTER the DOLISTs are finished, return the answer
      answer)))

(newline)
(tester '(cartesian-product '(1 2)))
(tester '(cartesian-product '(1 2 3)))

;;; -----------------------
;;;  PROBLEM 1
;;; -----------------------

(problem "1:  TRANSITIVE?")

;;;  TRANSITIVE?
;;; -----------------------------------------------
;;;  INPUT:  LIST-O-PAIRS, a list of pairs representing a relation
;;;            over some set A
;;;  OUTPUT:  #t if the relation is transitive; #f otherwise.

(define transitive?
  (lambda (list-o-pairs)
    (let ((answer #t))
      ;; Use nested DOLISTs to walk through all pairs of pairs.
      (dolist (first-pair list-o-pairs)
              (dolist (second-pair list-o-pairs)
                      ;; Suppose FIRST-PAIR = (X Y)
                      ;; And SECOND-PAIR = (U V)
                      ;;  Only worry about situation where Y = X (otherwise,
                      ;;    transitivity does not make any requirement)
                      (when (and (eq? (second first-pair) (first second-pair))
                                 ;; We have a violation of transitivity if
                                 ;; (X V) is not in the relation
                                 (not (member (list (first first-pair) 
                                                    (second second-pair))
                                              list-o-pairs)))
                        ;; Print out the violation
                        (printf "  ~A, ~A; but not ~A~%" 
                                first-pair
                                second-pair 
                                (list (first first-pair) (second second-pair)))
                        ;; Record that we got a violation
                        (set! answer #f))))
      ;; AFTER the DOLIST finishes, return the answer
      answer)))

(tester '(transitive? '((1 2) (1 1) (3 2) (2 1) (2 3))))
(tester '(transitive? '((2 3) (1 2) (1 3))))

;;;  EQUIV-RELN?
;;; ----------------------------------------------
;;;  INPUTS:  LIST-O-PAIRS, a list of pairs, representing a relation 
;;;             over some set A
;;;           THE-SET-A, a list representing the set A
;;;  OUTPUT:  #t if the given relation is an equivalence relation over A

(define equiv-reln?
  (lambda (list-o-pairs the-set-a)
    ;; By definition...
    (and (reflexive? list-o-pairs the-set-a)
         (symmetric? list-o-pairs)
         (transitive? list-o-pairs))))

(tester '(equiv-reln? '((1 1) (2 2) (3 3)) '(1 2 3)))
(tester '(equiv-reln? '((3 3) (1 2) (2 1) (1 1) (2 2)) '(1 2 3)))
(tester '(equiv-reln? '((3 3) (1 2) (1 1) (2 2)) '(1 2 3)))

;;; ------------------------
;;;   PROBLEM 3
;;; ------------------------

(problem "3:  PARTITION->EQUIV-RELN")

;;;  PARTITION->EQUIV-RELN
;;; -----------------------------------------
;;;  INPUT:  LIST-O-SUBSETS, a list of lists representing a partition of 
;;;             some set A
;;;  OUTPUT:  The corresponding equivalence relation, represented as a 
;;;             list of pairs.

(define partition->equiv-reln
  (lambda (list-o-subsets)
    (flatten (map cartesian-product list-o-subsets))))

(tester '(partition->equiv-reln '((1 2) (3) (4 5))))
(tester '(partition->equiv-reln '((1 2 3) (4) (5))))

(tester '(equiv-reln? (partition->equiv-reln '((1 2) (3) (4 5)))
                      '(1 2 3 4 5)))
(tester '(equiv-reln? (partition->equiv-reln '((1 2 3) (4) (5)))
                      '(1 2 3 4 5)))