(begin
(load "ex1.scm")
;(define (make-rat n d) (cons n d))
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
(display (numer x))
(display "/")
(display (denom x))
(newline))
;ex 2.1
(define (positive? x) (> x 0))
(define (negative? x) (< x 0))
(define (make-rat n d)
(let ((g (gcd n d)))
(if (positive? (* n d))
(cons (/ (abs n) g) (/ (abs d) g))
(cons (/ (- (abs n)) g) (/ (abs d) g)))))
;ex 2.2
(define (make-point x y)
(cons x y))
(define (x-point p)(car p))
(define (y-point p)(cdr p))
(define (print-point p)
(display "x:")
(display (x-point p))
(display " y:")
(display (y-point p))
(newline)
)
(define (make-segment p1 p2) (cons p1 p2))
(define (start-segment s)(car s))
(define (end-segment s)(cdr s))
(define (print-segment s)
(display "[start:")
(display (x-point (start-segment s)))
(display " ")
(display (y-point (start-segment s)))
(display "] ")
(display "[end:")
(display (x-point (end-segment s)))
(display " ")
(display (y-point (end-segment s)))
(display "]")
(newline)
)
;线段长度
(define (length-segment s)
(sqrt (+ (square (- (x-point (start-segment s)) (x-point (end-segment s))))
(square (- (y-point (start-segment s)) (y-point (end-segment s)))))))
;线段中点
(define (midpoint-segment s)
(make-point (average (x-point (start-segment s)) (x-point (end-segment s)))
(average (y-point (start-segment s)) (y-point (end-segment s)))))
;ex 2.3
;使用2端点定义矩形
(define (make-rectangle t-left b-right)
(if (= (y-point t-left) (y-point b-right))
(error "can't make a rectangle");如果两点构成的线段平行与x轴则无法构成矩形
(cons t-left b-right)))
(define (top-left r) (car r))
(define (bottom-right r) (cdr r))
;计算矩形的周长
(define (perimeter-rectangle r)
(* 2
(+ (abs (- (y-point (top-left r)) (y-point (bottom-right r))))
(abs (- (x-point (top-left r)) (x-point (bottom-right r)))))))
;计算矩形面积
(define (area-rectangle r)
(* (abs (- (y-point (top-left r)) (y-point (bottom-right r))))
(abs (- (x-point (top-left r)) (x-point (bottom-right r))))))
;ex 2.4
(define (cons1 x y)
(lambda (m) (m x y)))
(define (car1 z)
(z (lambda (p q) p)))
(define (cdr1 z)
(z (lambda (p q) q)))
;ex 2.5 看下 2^2 * 3^3的二进制表示,注:序对不能有负数
(define (cons2 x y) (* (fast-expt 2 x) (fast-expt 3 y)))
(define (car2 z)
(define (iter n z)
(if (= (remainder z 2) 0)
(iter (+ n 1) (/ z 2))
n))
(iter 0 z))
(define (cdr2 z)
(define (iter n z)
(if (= (remainder z 3) 0)
(iter (+ n 1) (/ z 3))
n))
(iter 0 z))
;ex 2.17
(define (last-pair p)
(define (last-pair-imp front back)
(if (null? back)
(list front)
(last-pair-imp (car back) (cdr back))))
(if (null? p)
p
(last-pair-imp (car p) (cdr p))))
;ex 2.18
;递归
(define (reverse p)
(define (reverse-pair-imp front back)
(cond ((null? back) (list front))
(else (append (reverse-pair-imp (car back) (cdr back)) (list front)))))
(if (null? p)
p
(reverse-pair-imp (car p) (cdr p))))
;迭代
(define (reverse2 items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons (car things)
answer))))
(iter items nil))
;ex 2.19
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))
;: (cc 100 us-coins)
(define no-more? null?)
(define except-first-denomination cdr)
(define first-denomination car)
(define (cc amount coin-values)
(cond ((= amount 0) 1)
((or (< amount 0) (no-more? coin-values)) 0)
(else
(+ (cc amount
(except-first-denomination coin-values))
(cc (- amount
(first-denomination coin-values))
coin-values)))))
;ex 2.20
(define (same-parity x . y)
(define (same-parity-imp checker front back)
(define (process front) (if (checker front)(list front)nil))
(if (null? back)(process front)
(append (process front) (same-parity-imp checker (car back) (cdr back)))))
(if (even? x) (same-parity-imp even? x y)
(same-parity-imp odd? x y)))
;ex 2.21
(define (square-list1 items)
(map square items))
;ex 2.22
(define (square-list2 items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons (square (car things))
answer))))
(reverse2 (iter items nil)))
;ex 2.23
(define (for-each proc items)
(define (iter things)
(cond ((null? things))
(else
(proc (car things))
(iter (cdr things)))))
(iter items))
;ex 2.27
(define (deep-reverse tree)
(cond ((null? tree) nil)
((not (pair? tree)) tree)
(else (reverse (map deep-reverse tree)))))
;ex 2.28
(define (fringe tree)
(cond ((null? tree) nil)
((not (pair? tree))(list tree))
(else (append (fringe (car tree)) (fringe (cdr tree))))))
;ex 2.30 使用map
(define (square-tree tree)
(cond ((null? tree) nil)
((not (pair? tree)) (square tree))
(else (map square-tree tree))))
;ex 2.30直接定义
(define (square-tree2 tree)
(cond ((null? tree) nil)
((not (pair? tree)) (square tree))
(else (cons (square-tree2 (car tree))
(square-tree2 (cdr tree))))))
;ex 2.31
(define (tree-map func tree)
(define (tree-map-imp tree)
(cond ((null? tree) nil)
((not (pair? tree)) (func tree))
(else (map tree-map-imp tree))))
(tree-map-imp tree))
(define (square-tree3 tree) (tree-map square tree))
;ex 2.32 产生子集合的方式,将集合a分成两部分(front back)
;a的子集合 = back的子集合 + 将front插入到back的所有子集合中产生的集合
(define (subsets s)
(if (null? s)
(list nil)
(let ((rest (subsets (cdr s))))
(display "rest:")(display rest)(newline)
(append rest (map (lambda (rest) (cons (car s) rest)) rest)))))
;ex 2.33
(define (map2 p sequence)
(accumulate (lambda (x y) (cons (p x) y)) nil sequence))
(define (append2 seq1 seq2)
(accumulate cons seq2 seq1))
(define (length2 sequence)
(accumulate (lambda (_ counter) (+ 1 counter)) 0 sequence))
;ex 2.34
(define (horner-eval x coefficient-sequence)
(accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
0
coefficient-sequence))
;: (horner-eval 2 (list 1 3 0 5 0 1))
;ex 2.35
(define (count-leaves2 t)
(define (cal node count)
(if (pair? node) (+ (accumulate cal 0 node) count);当前节点的叶子数+其它兄弟的叶子数
(+ 1 count))
)
(accumulate cal 0 t))
;map fringe将((1 11) 10 (2 (3 4 5 (7 8))))) 展开成 ((1 11) (10) (2 3 4 5 7 8))
;分别计算每个子表的length累加即可
(define (count-leaves3 t)
(accumulate (lambda (node counter) (+ (length node) counter)) 0 (map fringe t)))
;ex 2.36
(define a_s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
(define (accumulate-n op init seqs)
(if (null? (car seqs))
nil
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
;ex 2.37
(define _mat (list (list 1 2 3) (list 4 5 6) (list 7 8 9)))
(define (transpose mat) ;矩阵转置
(accumulate-n cons nil mat))
;其余两个略去...
;ex 2.38
;fold-right和fold-left的主要区别
;fold-right op会首先被应用到最右边的成员
;fold-left op首先被应用到最左边的成员
;要想op对fold-right和fold-left的任何输入序列都输出相同的结果,op必须满足交换率
(define fold-right accumulate)
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest))
(cdr rest))))
(iter initial sequence))
;ex 2.39
(define (reverse3 sequence)
(fold-right (lambda (x y) (append y (list x))) nil sequence))
(define (reverse4 sequence)
(fold-left (lambda (x y) (cons y x)) nil sequence))
;ex 2.40
(define (unique-pairs n)
(define (process i)
(map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1)))
)
(accumulate append nil (map process (enumerate-interval 1 n))))
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum-pairs n)
(map make-pair-sum (filter prime-sum? (unique-pairs n))))
;ex 2.41
(define (m-pairs2 n m)
(define (iter l j ret)
(cond ((< j 1)
(list ret))
(else
(accumulate
append
nil
(map (lambda (x)
(cond ((< x j) nil)
(else (iter (- x 1) (- j 1) (cons x ret)))))
(enumerate-interval 1 l))))))
(iter n m nil))
;(define (unique-pairs n) (m-pairs n 2))
;(((1 2)(3 4))(5 6))->((1 2)(3 4)(5 6))
(define (flat seq)
(define (iter seq ret)
(cond ((not (pair? seq)) ret)
((null? (car seq)) (cons nil ret))
((pair? (car seq))
;可以替换这两行看下区别
;(let ((ret2 (iter (car seq) ret)))
; (iter (cdr seq) ret2)))
(let ((ret2 (iter (cdr seq) ret)))
(iter (car seq) ret2)))
(else (cons seq ret)))
)
(iter seq nil)
)
;给定一个列表,从中提取n个所有集合
;例如(a b c d)->((a b c) (a c d) (a b d) (b c d))
;这个简单的问题整了我一天多,对函数式语言还是不熟啊
(define (pick-n seq n)
;(d-table (1 2 3) 1)->((1 2 3) (2 3) (3))
;(d-table (1 2 3) 2)->((1 2 3) (2 3))
;(d-table (1 2 3) 3)->((1 2 3))
(define (d-table seq n)
(cond ((= n 0) nil)
(else
(if (<= (length seq) n) (list seq)
(cons seq (d-table (cdr seq) n ))))))
(define (process seq)
(let ((size (length seq)))
(cond ((<= n 1) (if (pair? seq) (list (car seq)) seq))
((<= size n) seq)
(else
(map (lambda (x)(cons (car seq) x)) (pick-n (cdr seq) (- n 1))))))
)
(flat (map process (d-table seq n)))
)
;更简单的实现
(define (pick2-n seq n)
(define (d-table seq n)
(cond ((= n 0) nil)
(else
(if (<= (length seq) n) (list seq)
(cons seq (d-table (cdr seq) n ))))))
(define (process seq)
(let ((size (length seq)))
(cond ((<= n 1) (if (pair? seq) (list (car seq)) seq))
((<= size n) (list seq))
(else
(map (lambda (x)
(if (pair? x)(cons (car seq) x)
(cons (car seq) (list x)))) (pick2-n (cdr seq) (- n 1))))))
)
(flatmap process (d-table seq n))
)
(define (pick3-n seq n)
;从n个中选m个->从n-1个中选m个的集合+(将头部取出插入到从n-1个中选m-1个的集合)
(define (process seq)
(cond ((<= n 0) (list nil))
((<= (length seq) n) seq)
(else
(cons (pick3-n (cdr seq) n) (map (lambda (x)(cons (car seq) x)) (pick3-n (cdr seq) (- n 1)))))
)
)
(flat (process seq))
)
(define (unique-pairs2 n) (pick-n (enumerate-interval 1 n) 2))
;(define (3-pairs n) (pick-n (enumerate-interval 1 n) 3))
(define (m-pairs n m) (pick-n (enumerate-interval 1 n) m))
;flatmap练习
(define (test1 i)
(define (process x)
(map (lambda (y) (list x y))(enumerate-interval 1 x))
)
(flatmap process (enumerate-interval 1 i))
)
(define (test2 i j)
(define (process x)
(map (lambda (y) (list x y))(enumerate-interval 1 j))
)
(flatmap process (enumerate-interval 1 i))
)
;(flatmap (lambda (x) (map square x)) (list (list 1) (list 2)))
;2.31引号
;'后的对象表示对象应该作为数据而不是该求值的表达试对待
;(accumulate (lambda (x y) (cons (list x) y)) nil ''a)
;''a 表示一个列表其内容为(quote a)与(list 'quote 'a),'(quote a)等价
;(cons 'quote 'a)->(quote . a)
;(cons 'quote (list 'a))-> ''a
;(accumulate (lambda (x y) (cons (list x) y)) nil (car '('a))
;'('a)表示列表中有一个元素为('a) (car '('a)) 等价于 ''a
;比较''a 于 '('a)的区别(car (cdr ''a)) = (car (cdr (car '('a)))) = 'a
;ex 2.56
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
;(define (make-sum a1 a2) (list '+ a1 a2))
;(define (make-product m1 m2) (list '* m1 m2))
(define (sum? x)
(and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (product? x)
(and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list '+ a1 a2))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))
;用base^expon表示base的expon次幂
(define (make-exponentiation base expon)
(if (number? expon)
(cond ((= expon 0) 1)
((= expon 1) base)
(else (list '^ base expon)))
(list '^ base expon))
)
(define make-exp make-exponentiation)
(define (exponentiation? e)
(if (pair? e)(eq? (car e) '^)#f))
(define is-exp? exponentiation?)
(define (base e)
(if (not is-exp?) (error "e is not a exponentiation")
(car (cdr e))))
(define (exponent e);获得指数
(if (not is-exp?) (error "e is not a exponentiation")
(car (cddr e))))
(define (exponent-dec e);指数-1
(let ((expon (exponent e)))
(if (number? expon) (make-exp (base e) (- expon 1))
(make-exp (base e) (list '- expon 1)))))
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
;对幂的处理
((is-exp? exp)
(make-product (make-product (exponent exp) (exponent-dec exp))
(deriv (base exp) var))
)
(else
(error "unknown expression type -- DERIV" exp))))
;ex 2.57
(define (augend s)
(if (> (length (cddr s)) 1) (append (list '+) (cddr s))
(caddr s)))
(define (multiplicand p)
(if (> (length (cddr p)) 1) (append (list '*) (cddr p))
(caddr p)))
;ex 2.58
;中缀表示
(define (sum? x)
(and (pair? x) (eq? (cadr x) '+)))
(define (addend s) (car s))
(define (augend s)
(if (> (length (cddr s)) 1) (cddr s)
(caddr s)))
(define (product? x)
(and (pair? x) (eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (multiplicand p)
(if (> (length (cddr p)) 1) (cddr p)
(caddr p)))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list a1 '+ a2))))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list m1 '* m2))))
;(deriv '(x * y * (x + 3)) 'x)
;(deriv '(x + 3 * (x + y + 2))
)
