scheme代码

这是《The little schemer》中的练习。

//删除表lat中的itme元素,其他元素位置保持不变
(define (rember item lat)
    (cond ((null? lat)'())
          (else (cond((eq? item (car lat)) (cdr lat))
                (else (cons (car lat)(rember item (cdr lat))))))))

//获取列表的第一个元素，且这个列表元素必须也是一个表
(define (first lat)
    (cond ((null? lat)'())
          (else (if(pair? (car lat))
                   (cons (car (car lat))
                         (first (cdr lat)))
                   '()))))

//lat是表，new old是原子，将old替换成new，然后其他元素保持不变
(define replace new old lat)
    (cond ((null? lat) '())
          (else (cond ((eq? old (car lat)) (cons new (cdr lat)))
                (else (cons (car lat) (replace new old (cdr lat))))))))

//lat是表，new old是原子，如果lab包含old元素，就在old做左边插入new，然后其他元素保持不变
(define (insertL new old lat)
    (cond ((null? lat) '())
          (else (cond ((eq? old (car lat)) (cons new lat))
                (else (cons (car lat) (insertL new old (cdr lat))))))))

//lat是表，new old是原子，如果lab包含old元素，就在old做右边插入new，然后其他元素保持不变
(define (insertR new old lat)
    (cond ((null? lat) '())
          (else (cond ((eq? old (car lat)) (cons (car lat) (cons new (cdr lat))))
                (else (cons (car lat) (insertR new old (cdr lat))))))))

//lat是表，new old1 old2是原子，如果lat包含old1，或者old2，
//那么new将替换到第一个遇到的，其他元素保持不变
(define subst2 
    (lambda (new old1 old2 lat)
      (cond ((null? lat)'())
            (else (cond ((or (eq? (car lat) old1)(eq? (car lat) old2))
                         (cdr lat))
                        (else (cons (car lat)
                                    (subst2 new old1 old2 (cdr lat)))))))))

//在old元素右边插入new，如有多个则都插入
(define (multinsertR new old lat)
    (cond ((null? lat) '())
          (else (cond ((eq? old (car lat)) 
                       (cons (car lat) (cons new (multinsertR new old (cdr lat)))))
                      (else (cons (car lat) (multinsertR new old (cdr lat))))))))

//定义减一过程
(define (sub1 n)
    (- n 1))

//定义加一过程
(define add1
    (lambda (n)
       (+ n 1)))

//定义递归加法
(define o+ 
    (lambda (m n)
      (cond ((zero? n) m)
            (else (add1 (o+ m (sub1 n)))))))

//定义递归减法
(define o-
    (lambda (m n)
      (cond ((zero? n) m)
            (else (sub1 (o- m (sub1 n)))))))

//定义数组加法，其中tup是数组，即表的每个元素都是一个数字
(define (addtup tup)
    (cond ((null? tup) 0)
          (else (o+ (car tup)(addtup (cdr tup))))))
//定义乘法
(define *
    (lambda( m n)
      (cond ((zero? n) 0)
            (else (o+ m (* m (sub1 n)))))))

//当lat的元素可能是表时，删除与a相同的元素的过程；它的改进方法是：
//将最后的else部分改为 (cons (rember* a (car lat)) (rember* a (cdr lat)))
(define (rember* a lat)
    (cond ((null? lat) '())
          ((atom? (car lat)) 
           (cond ((eq? (car lat) a)(rember* a (cdr lat)))
                 (else (cons (car lat) (rember* a (cdr lat))))))
          (else ( cond ((eq? (car(car lat)) a) 
                        (cons (rember* a (cdr (car lat))) (rember* a (cdr lat))))
                       (else (cons (cons (car (car lat))(rember* a (cdr (car lat))))
                                   (rember* a (cdr lat))))))))

(define (rember* a lat)
    (cond ((null? lat) '())
          ((atom? (car lat)) 
           (cond ((eq? (car lat) a)(rember* a (cdr lat)))
                 (else (cons (car lat) (rember* a (cdr lat))))))
          (else ( cond ((eq? (car(car lat)) a) 
                        (cons (rember* a (cdr (car lat))) (rember* a (cdr lat))))
                       (else (cons (rember* a (car lat))
                                   (rember* a (cdr lat))))))))

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

//输入是一个list，取出其中重复的元素，因为set表示没有重复的集合
(define (makeset lat)
    (cond ((null? lat)(quote ()))
          (else (cond ((member? (car lat)(cdr lat)) (makeset(cdr lat)))
                      (else (cons (car lat)(makeset (cdr lat))))))))

//检验lat1是否为lat2的子集
(define (subset lat1 lat2)
    (cond ((null? lat1)#t)
          (else (cond((member? (car lat1) lat2)
                      (subset (cdr lat1) lat2))
                     (else #f))))) 


//a shorter one
(define (subset lat1 lat2)
    (cond ((null? lat1)#t)
          ((member? (car lat1) lat2)
                      (subset (cdr lat1) lat2))