litlle_scheme7.ss

(define eqan?
  (lambda (a1 a2)
    (cond
     ((and (number? a1) (number? a2) (= a1 a2)))
     ((or (number? a1) (number? a2)) #f)
     (else (eq? a1 a2)))))

(eqan? 3 5)
(eqan? 3 'hoge)

(define member?
  (lambda (a lat)
    (cond
     ((null? lat) #f)
     (else (or (eq? (car lat) a)
	       (member? a (cdr lat)))))))

(define set?
  (lambda (lat)
    (cond
     ((null? lat) #t)
     (else
      (cond
       ((member? (car lat) (cdr lat)) #f)
       (else (set? (cdr lat))))))))

(set? '(apple peaches apple plum))
(set? '(apples peaches pears plums))
(set? '(apple 3 pear 4 9 apple 3 4))


(define member2?
  (lambda (a lat)
    (cond
     ((null? lat) #f)
     (else (or (eqan? (car lat) a)
	       (member2? a (cdr lat)))))))

(define set2?
  (lambda (lat)
    (cond
     ((null? lat) #t)
     (else
      (cond
       ((member2? (car lat) (cdr lat)) #f)
       (else (set2? (cdr lat))))))))

(set2? '(apple peaches apple plum))
(set2? '(apples peaches pears plums))
(set2? '(apple 3 pear 4 9 orange 5))

(define makeset
  (lambda (lat)
    (cond
     ((null? lat) (quote ()))
     ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
     (else (cons (car lat) (makeset (cdr lat)))))))

(makeset '(apple peach pear peach plum apple lemon peach))
(makeset '(apple 3 pear 4 9 apple 3 4))

(define subset?
  (lambda (set1 set2)
    (cond
     ((null? set1) #t)
     (else (and (member? (car set1) set2) (subset? (cdr set1) set2))))))

(subset? '(5 chicken wings) '(5 hamburgers 2 pieces fried chicken and light duckling wings))
(subset? '(5 chicken wings) '(four pounds chicken and 5 ounces horseradish))

(define eqset?
  (lambda (set1 set2)
    (and (subset? set1 set2) (subset? set2 set1))))

(define intersect?
  (lambda (set1 set2)
    (cond
     ((null? set1) #f)
     (else (or (member? (car set1) set2)
	       (intersect? (cdr set1) set2))))))

(intersect? '(stewed tomatoes and macaroni) '(macaroni and cheese))

(define intersect
  (lambda (set1 set2)
    (cond
     ((null? set1) (quote ()))
     ((member? (car set1) set2) (cons (car set1) (intersect (cdr set1) set2)))
     (else (intersect (cdr set1) set2)))))

(intersect '(stewed tomatoes and macaroni) '(macaroni and cheese))

(define union
  (lambda (set1 set2)
    (cond
     ((null? set1) set2)
     ((member? (car set1) set2) (union (cdr set1) set2))
     (else (cons (car set1) (union (cdr set1) set2))))))

(union '(stewed tomatoes and macaroni casserole) '(macaroni and cheese))

(define setminus
  (lambda (set1 set2)
    (cond
     ((null? set1) (quote ()))
     ((member? (car set1) set2) (setminus (cdr set1) set2))
     (else (cons (car set1) (setminus (cdr set1) set2))))))

(setminus '(stewed tomatoes and macaroni casserole) '(macaroni and cheese))

(define intersectall 
  (lambda (l-set)
    (cond
     ((null? (cdr l-set)) (car l-set))
     (else (intersect (car l-set) (intersectall (cdr l-set)))))))

(intersectall '((a b c) (c a d e) (e f g h a b)))
(intersectall '((6 pears and) (3 peachies and 6 peppers) (8 pears and 6 plums) (and 6 prunes with lots of apples)))

(define atom?
  (lambda (x)
    (and (not (pair? x)) (not (null? x)))))

(define a-pair?
  (lambda (x)
    (cond
     ((atom? x) #f)
     ((null? x) #f)
     ((null? (cdr x)) #f)
     ((null? (cdr (cdr x))) #t)
     (else #f))))

(a-pair? '(pear pear))
(a-pair? '(3 7))
(a-pair? '(3))

(define first
  (lambda (a)
    (car a)))

(define second
  (lambda (a)
    (car (cdr a))))

(define build
  (lambda (a1 a2)
    (cons a1 (cons a2 (quote ())))))

(build 'a 'b)

(define firsts
  (lambda (l)
    (cond
     ((null? l) (quote ()))
     (else
      (cons (first (car l)) (firsts (cdr l)))))))

(define seconds
  (lambda (l)
    (cond
     ((null? l) (quote ()))
     (else
      (cons (second (car l)) (seconds (cdr l)))))))


(firsts '((b 4) (b 0) (b 9) (e 5) (g 4)))
(firsts '((8 3) (4 2) (7 6) (6 2) (3 4)))

(define fun?
  (lambda (rel)
    (set? (firsts rel))))

(fun? '((8 3) (4 2) (7 6) (6 2) (3 4)))
(fun? '((b 4) (b 0) (b 9) (e 5) (g 4)))

;; (define revrel
;;   (lambda (rel)
;;     (cond
;;      ((null? rel) (quote ()))
;;      (else (cons (build (second (car l)) (first (car l))) (revrel (cdr rel)))))))

(define revpair
  (lambda (pair)
    (build (second pair) (first pair))))

(revpair '(3 (hoge)))

(define revrel
  (lambda (rel)
    (cond
     ((null? rel) (quote ()))
     (else
      (cons (revpair (car rel)) (revrel (cdr rel)))))))

(revrel '((b 4) (b 0) (b 9) (e 5) (g 4)))

(define fullfun?
  (lambda (fun)
    (and (set? (firsts fun)) (set? (seconds fun)))))

(fullfun? '((8 3) (4 8) (7 6) (6 2) (3 4)))

(define one-to-one?
  (lambda (fun)
    (and (fun? fun)) (fun? (revrel fun))))

(one-to-one? '((8 3) (4 8) (7 6) (6 2) (3 4)))
(one-to-one? '((8 3) (4 8) (7 6) (6 2) (3 2)))