PL HW6: Scheme

1.scm

(define (weave xs ys zs)
   (if 
     (or (null? xs) (null? ys) (null? zs)) 
     '()
     (cons (list (car xs) (car ys) (car zs)) 
           (weave (cdr xs) (cdr ys) (cdr zs)))))

2a.scm

(define (set? xs) 
  (or (null? xs)
      (and (set? (cdr xs)) (not (member (car xs) (cdr xs))))))

2b.scm

(define (make-set xs) 
  (if (null? xs) 
      xs
      (if (member (car xs) (cdr xs)) (make-set (cdr xs)) (cons (car xs) (make-set (cdr xs))))))

2c.scm

(define (remove-elt x xs)
  (if (null? xs) 
      xs
      (if (eq? x (car xs)) 
          (remove-elt x (cdr xs))
          (cons (car xs) (remove-elt x (cdr xs))))))

2d.scm

(define (set-intersect xs ys)
  (if (null? xs) 
      '()
      (if (member (car xs) ys) 
          (cons (car xs) (set-intersect (cdr xs) ys))
          (set-intersect (cdr xs) ys))))

2e.scm

(define (cons-each elt lists)
  (if (null? lists) 
      '()
      (cons (cons elt (car lists)) (cons-each elt (cdr lists)))))


(define (power-set xs)
  (if (null? xs) 
      '(())
      (append (power-set (cdr xs)) (cons-each (car xs) (power-set (cdr xs))))))

2f.scm

(define (set-member x xs)
  (if (null? xs)
      #f
      (or  ((if (list? x) set-equal eq?) x (car xs))
           (set-member x (cdr xs)))))

(define (remove-elt x xs)
    (if ((if (list? x) set-equal eq?) x (car xs))
        (cdr xs)
        (cons (car xs) (remove-elt x (cdr xs)))))

(define (set-equal xs ys)
  (if (null? xs) 
      (null? ys)
      (and (set-member (car xs) ys) 
           (set-equal (cdr xs) (remove-elt (car xs) ys)))))

hw6.scm

; Assignment VI: Scheme. 
; 1. Write a function Weave, that takes three lists of the same lenght, and builds a list of triples with the corresponding entries in each list.
(define (weave xs ys zs)
   (if 
     (or (null? xs) (null? ys) (null? zs)) 
     '()
     (cons (list (car xs) (car ys) (car zs)) 
           (weave (cdr xs) (cdr ys) (cdr zs)))))

; 2a) set? applies to a list, and returns true if the list contains no duplicates. The built-in predicate member is useful here. 
(define (set? xs) 
  (or (null? xs)
      (and (set? (cdr xs)) (not (member (car xs) (cdr xs))))))


; b) make-set takes an arbitrary list and removes duplicates in it. thereby creating the corresponding set. 
(define (make-set xs) 
  (if (null? xs) 
      xs
      (if (member (car xs) (cdr xs)) (make-set (cdr xs)) (cons (car xs) (make-set (cdr xs))))))

; c) set-equal returns true if two lists that are sets have the same elements, in any order. 
(define (remove-elt x xs)
  (if (null? xs) 
      xs
      (if (eq? x (car xs)) 
          (remove-elt x (cdr xs))
          (cons (car xs) (remove-elt x (cdr xs))))))
          
(define (set-equal xs ys)
  (if (null? xs) 
      (null? ys)
      (and (member (car xs) ys) 
           (set-equal (cdr xs) (remove-elt (car xs) ys)))))

;d) set-intersect is a binary operation that returns the set of elements common to two sets.
(define (set-intersect xs ys)
  (if (null? xs) 
      '()
      (if (member (car xs) ys) 
          (cons (car xs) (set-intersect (cdr xs) ys))
          (set-intersect (cdr xs) ys))))

;e) power-set build the set of all subsets of a set. For example, (power-set ' (a b c)) yields: 
(define (cons-each elt lists)
  (if (null? lists) 
      '()
      (cons (cons elt (car lists)) (cons-each elt (cdr lists)))))


(define (power-set xs)
  (if (null? xs) 
      '(())
      (append (power-set (cdr xs)) (cons-each (car xs) (power-set (cdr xs))))))



;f) (Harder) The elements of a set are arbitrary, and can themselves be sets. Therefore, membership should be defined in terms of set equality, and viceversa. For example, we want to say that
;         (1 3 5) is an element of ( (2 4) (5 3 1) (0 2 3 4)).
;Similarly, ((1 2) (3 4))  and ((4 3) (2 1)) are equal as sets.
;Write the proper definitions for set-member and set-equal that handle arbitrary sets. 

(define (set-member x xs)
  (if (null? xs)
      #f
      (or  ((if (list? x) set-equal eq?) x (car xs))
           (set-member x (cdr xs)))))

(define (remove-elt x xs)
    (if ((if (list? x) set-equal eq?) x (car xs))
        (cdr xs)
        (cons (car xs) (remove-elt x (cdr xs)))))

(define (set-equal xs ys)
  (if (null? xs) 
      (null? ys)
      (and (set-member (car xs) ys) 
           (set-equal (cdr xs) (remove-elt (car xs) ys)))))