| ;((1. toys) 2)
(define atom?
(lambda (x)
(and (not (pair? x))
(not (null? x))))) ;((2. Do It, Do It Again, and Again, and Again ...) 14)
(define lat?
(lambda (lat)
(cond
((null? lat) #t)
((atom? (car lat))(lat? (cdr lat)))
(else #f)))) (define member?
(lambda (a lat)
(cond
((null? lat) #f)
(else (or (eq? a (car lat))
(member? a (cdr lat))))))) ;((3. Cons The Magnificent) 32)
(define rember
(lambda (a lat)
(cond
((null? lat) '())
((eq? a (car lat))(cdr lat))
(else (cons
(car lat)(rember a (cdr lat))))))) (define firsts
(lambda (l)
(cond
((null? l) '())
(else (cons
(car (car l))
(firsts (cdr l))))))) (define insertR
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons old
(cons new (cdr lat))))
(else (cons
(car lat)
(insertR new old (cdr lat))))))) (define insertL
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons new lat))
(else (cons
(car lat)
(insertL new old (cdr lat))))))) (define subst
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons new (cdr lat)))
(else (cons
(car lat)
(subst new old (cdr lat))))))) (define subst2
(lambda (new o1 o2 lat)
(cond
((null? lat) '())
((or (eq? o1 (car lat))(eq? o2 (car lat)))
(cons new (cdr lat)))
(else (cons
(car lat)
(subst2 new o1 o2 (cdr lat))))))) (define multirember
(lambda (a lat)
(cond
((null? lat) '())
((eq? a (car lat))
(multirember a (cdr lat)))
(else (cons
(car lat)
(multirember a (cdr lat))))))) (define multiinsertR
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons (car lat)
(cons new
(multiinsertR new old (cdr lat)))))
(else (cons
(car lat)
(multiinsertR new old (cdr lat))))))) (define multiinsertL
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons new
(cons (car lat)
(multiinsertL new old (cdr lat)))))
(else (cons (car lat)
(multiinsertL new old (cdr lat))))))) (define multisubst
(lambda (new old lat)
(cond
((null? lat) '())
((eq? old (car lat))
(cons new
(multisubst new old (cdr lat))))
(else (cons (car lat)
(multisubst new old (cdr lat))))))) ;((4. Numbers Games) 58)
(define add1
(lambda (n)
(+ n 1))) (define sub1
(lambda (n)
(- n 1))) (define o+
(lambda (n m)
(cond
((zero? m) n)
(else (add1 (o+ n (sub1 m))))))) (define o-
(lambda (n m)
(cond
((zero? m) n)
(else (sub1 (o- n (sub1 m))))))) (define tup?
(lambda (tup)
(cond ((null? tup) #t)
((number? (car tup))
(tup? (cdr tup)))
(else #f)))) (define addtup
(lambda (tup)
(cond ((null? tup) 0)
(else (o+ (car tup)
(addtup (cdr tup))))))) (define o*
(lambda (n m)
(cond ((zero? m) 0)
(else (o+ n (o* n (sub1 m))))))) (define tup+
(lambda (tup1 tup2)
(cond
((null? tup1) tup2)
((null? tup2) tup1)
(else (cons (o+ (car tup1)(car tup2))
(tup+ (cdr tup1)(cdr tup2))))))) (define >
(lambda (n m)
(cond
((zero? n) #f)
((zero? m) #t)
(else (> (sub1 n)(sub1 m)))))) (define <
(lambda (n m)
(cond
((zero? m) #f)
((zero? n) #t)
(else (< (sub1 n)(sub1 m)))))) (define =
(lambda (n m)
(cond
((zero? m)(zero? n))
((zero? n) #f)
(else (= (sub1 n)(sub1 m)))))) (define =
(lambda (n m)
(cond
((> n m) #f)
((< n m) #f)
(else #t)))) (define expt
(lambda (n m)
(cond
((zero? m) 1)
(else (o* n (expt n (sub1 m))))))) (define divide
(lambda (n m)
(cond
((< n m) 0)
(else (add1 (divide (o- n m) m)))))) (define length
(lambda (lat)
(cond
((null? lat) 0)
(else (add1 (length (cdr lat))))))) (define pick
(lambda (n lat)
(cond
((zero? (sub1 n))(car lat))
(else (pick (sub1 n)(cdr lat)))))) (define rempick
(lambda (n lat)
(cond
((zero? (sub1 n))(cdr lat))
(else (cons (car lat)
(rempick (sub1 n)(cdr lat))))))) (define no-nums
(lambda (lat)
(cond
((null? lat) '())
((number? (car lat))
(no-nums (cdr lat)))
(else (cons (car lat)
(no-nums (cdr lat))))))) (define all-nums
(lambda (lat)
(cond
((null? lat) '())
((number? (car lat))
(cons (car lat)(all-nums (cdr lat))))
(else (all-nums (cdr lat)))))) (define egan?
(lambda (a1 a2)
(cond
((and (number? a1)(number? a2))
(= a1 a2))
((or (number? a1)(number? a2))
#f)
(else (eq? a1 a2))))) (define occur
(lambda (a lat)
(cond
((null? lat) 0)
((eq? a (car lat))
(add1 (occur a (cdr lat))))
(else (occur a (cdr lat)))))) (define one?
(lambda (n)
(= n 1))) (define rempick
(lambda (n lat)
(cond
((null? lat) #f)
((one? n)(cdr lat))
(else (cons (car lat)
(rempick (sub1 n)(cdr lat))))))) ;((5. *Oh My Gawd*:It's Full of Stars) 80)
(define rember*
(lambda (a l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? a (car l))
(rember* a (cdr l)))
(else (cons (car l)
(rember* a (cdr l))))))
(else (cons (rember* a (car l))
(rember* a (cdr l))))))) (define insertR*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? old (car l))
(cons (car l)
(cons new
(insertR* new old (cdr l)))))
(else (cons (car l)
(insertR* new old (cdr l))))))
(else (cons (insertR* new old (car l))
(insertR* new old (cdr l))))))) (define insertL*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? old (car l))
(cons new
(cons (car l)
(insertL* new old (cdr l)))))
(else (cons (car l)
(insertL* new old (cdr l))))))
(else (cons (insertL* new old (car l))
(insertL* new old (cdr l))))))) (define occur*
(lambda (a l)
(cond
((null? l) 0)
((atom? (car l))
(cond
((eq? a (car l))
(add1 (occur* a (cdr l))))
(else (occur* a (cdr l)))))
(else (o+ (occur* a (car l))
(occur* a (cdr l))))))) (define subst*
(lambda (new old l)
(cond
((null? l) '())
((atom? (car l))
(cond
((eq? old (car l))
(cons new (subst* new old (cdr l))))
(else (cons (car l)(subst* new old (cdr l))))))
(else (cons (subst* new old (car l))
(subst* new old (cdr l))))))) (define member*
(lambda (a lat)
(cond
((null? lat) #f)
((atom? (car lat))
(cond
((eq? a (car lat)) #t)
(else (member* a (cdr lat)))))
(else (or (member* a (car lat))
(member* a (cdr lat))))))) (define leftmost
(lambda (l)
(cond
((atom? (car l))
(car l))
(else (leftmost (car l)))))) (define and
(lambda (a b)
(cond
(a b)
(else #f)))) (define or
(lambda (a b)
(cond
(a #t)
(else b)))) (define eqlist?
(lambda (l1 l2)
(cond
((and (null? l1)(null? l2)) #t)
((and (null? l1)(atom? (car l2))) #f)
((and (atom? (car l1))(null? l2)) #f)
((and (atom? (car l1))(atom? (car l2)))
(and (egan? (car l1)(car l2))
(eqlist? (cdr l1)(cdr l2))))
((atom? (car l1)) #f)
((null? l2) #f)
((atom? (car l2)) #f)
(else (and (eqlist? (car l1)(car l2))
(eqlist? (cdr l1)(cdr l2))))))) (define eqlist?
(lambda (l1 l2)
(cond
((and (null? l1)(null? l2)) #t)
((or (null? l1)(null? l2)) #f)
((and (atom? (car l1))
(atom? (car l2)))
(and (egan? (car l1)(car l2))
(eqlist? (cdr l1)(cdr l2))))
((or (atom? (car l1))
(atom? (car l2))) #f)
(else (and (eqlist? (car l1)(car l2))
(eqlist? (cdr l1)(cdr l2))))))) | 
0 件のコメント:
コメントを投稿