;;; ============================== ;;; CMPU-145, Spring 2013 ;;; Code from class ;;; Feb. 25, 2013 ;;; ============================== ;;; TESTER -- for convenience (define tester (lambda (expr) (printf "~A ==> " expr) (eval expr))) ;;; REFLEXIVE? ;;; ------------------------------ ;;; INPUTS: LIST-O-PAIRS, a list-of-lists representing a relation ;;; over some set A ;;; THE-SET-A, a list representing the set A ;;; OUTPUT: #t if the relation is reflexive (define reflexive? (lambda (list-of-pairs the-set-a) (let ((answer #t)) ;; Use DOLIST to walk through the set A (dolist (a the-set-a) ;; If you find that (a a) is NOT in the relation... (when (not (member (list a a) list-of-pairs)) ;; signal trouble... (printf " (~A,~A) not in there~%" a a) ;; and change the value of ANSWER to #f (set! answer #f))) ;; after the dolist, return ANSWER answer))) (tester '(reflexive? '((1 1) (3 3) (2 1) (1 2) (3 1)) '(1 2 3))) (tester '(reflexive? '((1 1) (3 3) (2 1) (2 2) (3 1)) '(1 2 3))) ;;; SYMMETRIC? ;;; ----------------------------------------- ;;; INPUTS: LIST-O-PAIRS, a list-of-lists representing a relation ;;; over some set A ;;; OUTPUT: #t if the relation is symmetric; #f otherwise (define symmetric? (lambda (list-o-pairs) (let ((answer #t)) ;; Use DOLIST to walk through the list of PAIRS (dolist (pr list-o-pairs) ;; If you find that the symmetric pair, (REVERSE PR), is ;; NOT in the relation... (when (not (member (reverse pr) list-o-pairs)) ;; then signal trouble... (printf "~A in there, but not ~A~%" pr (reverse pr)) ;; and change ANSWER to #f (set! answer #f))) ;; AFTER the dotimes, return ANSWER answer))) (newline) (tester '(symmetric? '((1 2) (3 4) (4 3) (2 1) (5 2) (3 3) (2 5)))) (tester '(symmetric? '((1 2) (3 4) (4 3) (2 5)))) (tester '(symmetric? '((3 3)))) ;;; cartesian-product ;;; -------------------------------------------------- ;;; INPUT: LISTY, a list representing a set ;;; OUTPUT: The cartesian product, LISTY x LISTY (i.e., a list of ;;; pairs (x y), where x and y are both in LISTY). (define cartesian-product (lambda (listy) ;; PRODUCT is an accumulator of pairs; it starts out empty (let ((product ())) ;; Use NESTED DOLISTs because we want to consider ;; all PAIRS of elements from listy (dolist (x listy) (dolist (y listy) ;; Accumulate the pair (x y) (set! product (cons (list x y) product)))) ;; AFTER the dolists, return the accumulator product))) (newline) (tester '(cartesian-product '(1 2 3))) (tester '(cartesian-product '(1 2))) ;;; flatten ;;; ------------------------------------ ;;; INPUT: LIST-O-LISTS, a list containing other lists as elements ;;; OUTPUT: A list that is the concatenation of all the sublists in ;;; the LIST-O-LISTS (define flatten (lambda (list-o-lists) (cond ;; Base Case: LIST-O-LISTS is empty ((null? list-o-lists) ()) ;; REDUNDANT: Recursive Case: First subset is empty ;;((null? (first list-o-lists)) ;; (flatten (rest list-o-lists))) ;; Recursive Case: LIST-O-LISTS is non-empty (else (append (first list-o-lists) (flatten (rest list-o-lists))))))) (newline) (tester '(flatten '((1 2) (3) (4 5 6) () (2 6)))) (tester '(apply append '((1 2) (3) (4 5 6) () (2 6)))) ;;; Alternate implementation of FLATTEN using APPLY and APPEND! (define flatten-alt (lambda (listy) (apply append listy))) (tester '(flatten-alt '((1 2) (3) (4 5 6) () (2 6))))