├── .gitignore ├── chapter1 ├── ex1_42.scm ├── ex1_41.scm ├── ex1_43.scm ├── ex1_18.scm ├── ex1_7.scm ├── ex1_8.scm ├── ex1_16.scm ├── ex1_35.scm ├── ex1_21.scm ├── ex1_11.scm ├── ex1_39.scm ├── ex1_32.scm ├── ex1_37.scm ├── ex1_31.scm ├── ex1_38.scm ├── ex1_19.scm ├── ex1_36.scm ├── ex1_46.scm ├── ex1_29.scm ├── ex1_30.scm ├── ex1_22.scm ├── ex1_40.scm ├── ex1_24.scm ├── ex1_45.scm └── ex1_33.scm └── chapter2 ├── ex2_17.scm ├── ex2_7.scm ├── ex2_47.scm ├── ex2_23.scm ├── ex2_18.scm ├── ex2_28.scm ├── ex2_20.scm ├── ex2_31.scm ├── ex2_12.scm ├── ex2_8.scm ├── ex2_21.scm ├── ex2_46.scm ├── ex2_30.scm ├── ex2_6.scm ├── ex2_38.scm ├── ex2_1.scm ├── ex2_32.scm ├── ex2_19.scm ├── ex2_36.scm ├── ex2_39.scm ├── ex2_34.scm ├── ex2_5.scm ├── ex2_10.scm ├── ex2_33.scm ├── ex2_2.scm ├── ex2_37.scm ├── ex2_35.scm ├── ex2_27.scm ├── ex2_41.scm ├── ex2_29.scm ├── ex2_48.scm ├── ex2_11.scm ├── ex2_40.scm ├── ex2_42.scm ├── ex2_3.scm ├── ex2_49.scm └── ex2_14.scm /.gitignore: -------------------------------------------------------------------------------- 1 | *.png 2 | *.swp 3 | -------------------------------------------------------------------------------- /chapter1/ex1_42.scm: -------------------------------------------------------------------------------- 1 | (define (compose f g) 2 | (lambda (x) (f (g x)))) 3 | 4 | (define (inc x) (+ x 1)) 5 | ((compose square inc) 6) 6 | -------------------------------------------------------------------------------- /chapter1/ex1_41.scm: -------------------------------------------------------------------------------- 1 | (define (double f) 2 | (lambda (x) (f (f x)))) 3 | 4 | (define (inc x) (+ x 1)) 5 | (((double (double double)) inc) 5) 6 | -------------------------------------------------------------------------------- /chapter2/ex2_17.scm: -------------------------------------------------------------------------------- 1 | (define (last-pair n) 2 | (if (null? (cdr n)) 3 | n 4 | (last-pair (cdr n)))) 5 | 6 | (last-pair (list 1 2 3 4)) 7 | -------------------------------------------------------------------------------- /chapter2/ex2_7.scm: -------------------------------------------------------------------------------- 1 | (define (make-interval a b) (cons a b)) 2 | (define (lower-bound z) (min (car z) (cdr z))) 3 | (define (upper-bound z) (max (car z) (cdr z))) 4 | -------------------------------------------------------------------------------- /chapter2/ex2_47.scm: -------------------------------------------------------------------------------- 1 | (define (make-frame origin edge1 edge2) 2 | (list origin edge1 edge2)) 3 | 4 | (define (origin-frame f) (car f)) 5 | (define (edge1-frame f) (cadr f)) 6 | (define (edge2-frame f) (caddr f)) 7 | -------------------------------------------------------------------------------- /chapter1/ex1_43.scm: -------------------------------------------------------------------------------- 1 | (define (compose f g) 2 | (lambda (x) (f (g x)))) 3 | 4 | ; 使用之前的compose来实现 5 | (define (repeated f n) 6 | (if (= n 1) 7 | f 8 | (compose f (repeated f (- n 1))))) 9 | 10 | ((repeated square 2) 5) 11 | -------------------------------------------------------------------------------- /chapter2/ex2_23.scm: -------------------------------------------------------------------------------- 1 | (define (for-each proc items) 2 | (cond ((null? items) true) 3 | (else 4 | (proc (car items)) 5 | (for-each proc (cdr items))))) 6 | 7 | (for-each (lambda (x) (newline) (display x)) (list 1 2 3)) 8 | -------------------------------------------------------------------------------- /chapter2/ex2_18.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (reverse n) 4 | (define (reverse-iter n l) 5 | (if (null? n) 6 | l 7 | (reverse-iter (cdr n) (cons (car n) l)))) 8 | (if (null? n) 9 | nil 10 | (reverse-iter (cdr n) (list (car n))))) ; 用list在第一个元素后面加nil 11 | 12 | (reverse (list 1 2 3 4 5)) 13 | -------------------------------------------------------------------------------- /chapter2/ex2_28.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (append list1 list2) 4 | (if (null? list1) 5 | list2 6 | (cons (car list1) (append (cdr list1) list2)))) 7 | 8 | (define (fringe tree) 9 | (cond ((null? tree) nil) 10 | ((not (pair? tree)) (list tree)) 11 | (else (append (fringe (car tree)) (fringe (cdr tree)))))) 12 | -------------------------------------------------------------------------------- /chapter1/ex1_18.scm: -------------------------------------------------------------------------------- 1 | (define (fast-mul b n) 2 | (define (double x) (+ x x)) 3 | (define (halve x) (/ x 2)) 4 | (define (even? x) (= (remainder x 2) 0)) 5 | (define (mul-iter a b n) 6 | (cond ((= n 0) a) 7 | ((even? n) (mul-iter a (double b) (/ n 2))) 8 | (else (mul-iter (+ a b) b (- n 1))))) 9 | (mul-iter 0 b n)) 10 | -------------------------------------------------------------------------------- /chapter1/ex1_7.scm: -------------------------------------------------------------------------------- 1 | (define (my-sqrt x) 2 | (define (good-enough? guess) 3 | (< (/ (abs (- (improve guess) guess)) guess) 0.01)) 4 | (define (improve guess) 5 | (/ (+ guess (/ x guess)) 2)) 6 | (define (sqrt-iter guess) 7 | (if (good-enough? guess) 8 | guess 9 | (sqrt-iter (improve guess)))) 10 | (sqrt-iter 1.0)) 11 | -------------------------------------------------------------------------------- /chapter1/ex1_8.scm: -------------------------------------------------------------------------------- 1 | (define (my-cubrt x) 2 | (define (good-enough? guess) 3 | (< (/ (abs (- (improve guess) guess)) guess) 0.001)) 4 | (define (improve guess) 5 | (/ (+ (* 2 guess) 6 | (/ x (square guess))) 7 | 3)) 8 | (define (cubrt-iter guess) 9 | (if (good-enough? guess) 10 | guess 11 | (cubrt-iter (improve guess)))) 12 | (cubrt-iter 1.0)) 13 | -------------------------------------------------------------------------------- /chapter2/ex2_20.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (same-partity first . other) 4 | (define (same? x) (= (remainder first 2) (remainder x 2))) 5 | (define (same-recur n) 6 | (cond ((null? n) nil) 7 | ((same? (car n)) (cons (car n) (same-recur (cdr n)))) ; 用递归cons来构造list 8 | (else (same-recur (cdr n))))) 9 | (cons first (same-recur other))) 10 | 11 | (same-partity 1 2 3 4 5 6 7) 12 | -------------------------------------------------------------------------------- /chapter1/ex1_16.scm: -------------------------------------------------------------------------------- 1 | ; 求幂的迭代计算过程 2 | ; 维护三个状态量a,b,n，a*b^n为不变量 3 | ; n为奇数时，a*b^n = (a*b)*b^(n-1) 4 | ; n为偶数时，a*b^n = a*(b*b)^(n/2) 5 | (define (fast-expt b n) 6 | (define (even? x) (= (remainder x 2) 0)) 7 | (define (fast-expt-iter a b n) 8 | (cond ((= n 0) a) 9 | ((even? n) (fast-expt-iter a (square b) (/ n 2))) 10 | (else (fast-expt-iter (* a b) b (- n 1))))) 11 | (fast-expt-iter 1 b n)) 12 | -------------------------------------------------------------------------------- /chapter2/ex2_31.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (tree-map proc tree) 4 | (cond ((null? tree) nil) 5 | ((not (pair? tree)) (proc tree)) 6 | (else (cons (map proc (car tree)) 7 | (map proc (cdr tree)))))) 8 | 9 | (define (square-tree tree) 10 | (tree-map square tree)) 11 | 12 | (square-tree (list 1 13 | (list 2 (list 3 4) 5) 14 | (list 6 7))) 15 | -------------------------------------------------------------------------------- /chapter1/ex1_35.scm: -------------------------------------------------------------------------------- 1 | (define tolerance 0.0001) 2 | 3 | (define (fixed-point f first-guess) 4 | (define (close-enough? v1 v2) 5 | (< (abs (- v1 v2)) tolerance)) 6 | (define (try guess) 7 | (let ((next (f guess))) 8 | (if (close-enough? guess next) 9 | next 10 | (try next)))) 11 | (try first-guess)) 12 | 13 | ; 寻找x->1+1/x的不动点 14 | (fixed-point (lambda (x) (+ (/ 1.0 x) 1)) 1.0) 15 | -------------------------------------------------------------------------------- /chapter2/ex2_12.scm: -------------------------------------------------------------------------------- 1 | (define (make-interval a b) (cons (min a b) (max a b))) 2 | (define (lower-bound z) (car z)) 3 | (define (upper-bound z) (cdr z)) 4 | 5 | (define (make-center-percent c p) 6 | (make-interval (- c (* c p)) (+ c (* c p)))) 7 | 8 | (define (center i) 9 | (/ (+ (lower-bound i) (upper-bound i)) 2)) 10 | 11 | (define (width i) 12 | (/ (- (upper-bound i) (lower-bound i)) 2)) 13 | 14 | (define (percent i) 15 | (/ (width i) (center i))) 16 | -------------------------------------------------------------------------------- /chapter1/ex1_21.scm: -------------------------------------------------------------------------------- 1 | (define (find-divisor n test-divisor) 2 | (define (divides? a b) (= (remainder b a) 0)) 3 | (cond ((> (square test-divisor) n) n) 4 | ((divides? test-divisor n) test-divisor) 5 | (else (find-divisor n (+ test-divisor 1))))) 6 | (define (smallest-divisor n) 7 | (find-divisor n 2)) 8 | (define (prime? n) 9 | (= n (smallest-divisor n))) 10 | 11 | (smallest-divisor 199) 12 | (smallest-divisor 1999) 13 | (smallest-divisor 19999) 14 | -------------------------------------------------------------------------------- /chapter1/ex1_11.scm: -------------------------------------------------------------------------------- 1 | (define (f-recur n) 2 | (cond ((< n 3) n) 3 | (else (+ (f-recur (- n 1)) (* 2 (f-recur (- n 2))) (* 3 (f-recur (- n 3))))))) 4 | 5 | (define (f-iter n) 6 | (define (f-sub-iter i a b c) 7 | (cond ((< n 3) n) 8 | ((= i n) a) 9 | (else (f-sub-iter (+ i 1) 10 | (+ a (* 2 b) (* 3 c)) 11 | a 12 | b)))) 13 | (f-sub-iter 2 2 1 0)) 14 | 15 | -------------------------------------------------------------------------------- /chapter1/ex1_39.scm: -------------------------------------------------------------------------------- 1 | (define (cont-frac n d k) ; 迭代计算过程 2 | (define (frac i prev) 3 | (/ (n i) (- (d i) prev))) 4 | (define (iter i result) 5 | (if (= i 0) 6 | result 7 | (iter (- i 1) (frac i result)))) 8 | (iter k 0)) 9 | 10 | ; 利用lambert公式逼近正切值tan 11 | (define (tan-cf x k) 12 | (define (d i) (- (* 2 i) 1)) 13 | (define (n i) 14 | (if (= i 1) 15 | x 16 | (square x))) 17 | (cont-frac n d k)) 18 | -------------------------------------------------------------------------------- /chapter2/ex2_8.scm: -------------------------------------------------------------------------------- 1 | (define (make-interval a b) (cons (min a b) (max a b))) 2 | (define (lower-bound z) (car z)) 3 | (define (upper-bound z) (cdr z)) 4 | 5 | (define (print-interval p) 6 | (newline) 7 | (display "(") 8 | (display (lower-bound p)) 9 | (display ",") 10 | (display (upper-bound p)) 11 | (display ")")) 12 | 13 | (define (sub-interval x y) 14 | (make-interval (- (lower-bound x) (upper-bound y)) 15 | (- (upper-bound x) (lower-bound y)))) 16 | -------------------------------------------------------------------------------- /chapter1/ex1_32.scm: -------------------------------------------------------------------------------- 1 | ; 定义一般性的累积函数 2 | (define (accumulate combiner null-value term a next b) ; 迭代计算过程 3 | (define (iter a result) 4 | (if (> a b) 5 | result 6 | (iter (next a) (combiner (term a) result)))) 7 | (iter a null-value)) 8 | 9 | (define (add a b) (+ a b)) 10 | (define (sum term a next b) 11 | (accumulate add 0 term a next b)) 12 | 13 | (define (mul a b) (* a b)) 14 | (define (product term a next b) 15 | (accumulate mul 1 term a next b)) 16 | -------------------------------------------------------------------------------- /chapter1/ex1_37.scm: -------------------------------------------------------------------------------- 1 | ; 计算k项有限连分式 2 | ; N_1 3 | ; __________________ 4 | ; N_2 5 | ; D_1+ _____________ 6 | ; D_2 + ... 7 | ; 8 | (define (cont-frac n d k) 9 | (define (frac i prev) 10 | (/ (n i) (+ (d i) prev))) 11 | (define (iter i result) 12 | (if (= i 0) 13 | result 14 | (iter (- i 1) (frac i result)))) 15 | (iter k 0)) 16 | 17 | ; Ni Di都取1,则会逼近黄金分割率的倒数 18 | (cont-frac (lambda (i) 1.0) 19 | (lambda (i) 1.0) 20 | 100) 21 | -------------------------------------------------------------------------------- /chapter2/ex2_21.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (map proc items) 4 | (if (null? items) 5 | nil 6 | (cons (proc (car items)) ; 递归构造list 7 | (map proc (cdr items))))) 8 | 9 | (define (square-list-a items) 10 | (if (null? items) 11 | nil 12 | (cons (square (car items)) 13 | (square-list-a (cdr items))))) 14 | 15 | (square-list-a (list 1 2 3 4 5)) 16 | 17 | (define (square-list-b items) 18 | (map square items)) 19 | 20 | (square-list-b (list 1 2 3 4 5)) 21 | -------------------------------------------------------------------------------- /chapter2/ex2_46.scm: -------------------------------------------------------------------------------- 1 | (define (make-vect x y) (cons x y)) 2 | (define (xcor-vect v) (car v)) 3 | (define (ycor-vect v) (cdr v)) 4 | 5 | (define (add-vect v1 v2) 6 | (make-vect (+ (xcor-vect v1) (xcor-vect v2)) 7 | (+ (ycor-vect v1) (ycor-vect v2)))) 8 | 9 | (define (sub-vect v1 v2) 10 | (make-vect (- (xcor-vect v1) (xcor-vect v2)) 11 | (- (ycor-vect v1) (ycor-vect v2)))) 12 | 13 | (define (scale-vect v s) 14 | (make-vect (* s (xcor-vect v)) 15 | (* s (ycor-vect v)))) 16 | 17 | -------------------------------------------------------------------------------- /chapter2/ex2_30.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (map proc items) 4 | (if (null? items) 5 | nil 6 | (cons (proc (car items)) 7 | (map proc (cdr items))))) 8 | 9 | (define (square-tree tree) 10 | (define (map-proc proc) ; 对proc改造，使之能够递归 11 | (lambda (tree) 12 | (if (pair? tree) 13 | (square-tree tree) 14 | (proc tree)))) 15 | (map (map-proc square) tree)) 16 | 17 | (square-tree (list 1 18 | (list 2 (list 3 4) 5) 19 | (list 6 7))) 20 | -------------------------------------------------------------------------------- /chapter2/ex2_6.scm: -------------------------------------------------------------------------------- 1 | (define (inc n) (+ n 1)) 2 | 3 | ; 丘奇计数 4 | ; 0表示x, 1表示(f x), 2表示(f (f x)) 5 | ; f和x都是可以指定的,这里以inc和0替代 6 | (define zero (lambda (f) (lambda (x) x))) 7 | 8 | (define (add-1 n) 9 | (lambda (f) (lambda (x) (f ((n f) x))))) 10 | 11 | ; ((zero inc) 0) 12 | ; (((add-1 zero) inc) 0) 13 | 14 | (define one 15 | (lambda (f) (lambda (x) (f x)))) 16 | (define two 17 | (lambda (f) (lambda (x) (f (f x))))) 18 | 19 | ; ((one inc) 0) 20 | ; ((two inc) 0) 21 | 22 | (define (add a b) 23 | (lambda (f) (lambda (x) ((a f) ((b f) x))))) 24 | 25 | ; (((add one two) inc) 0) 26 | -------------------------------------------------------------------------------- /chapter2/ex2_38.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (fold-right op init seqs) 4 | (if (null? seqs) 5 | init 6 | (op (car seqs) 7 | (fold-right op init (cdr seqs))))) 8 | 9 | (define (fold-left op init seqs) 10 | (define (iter result rest) 11 | (if (null? rest) 12 | result 13 | (iter (op result (car rest)) 14 | (cdr rest)))) 15 | (iter init seqs)) 16 | 17 | ; (fold-right / 1 (list 1 2 3)) 18 | ; (fold-left / 1 (list 1 2 3)) 19 | ; (fold-right list nil (list 1 2 3)) 20 | ; (fold-left list nil (list 1 2 3)) 21 | -------------------------------------------------------------------------------- /chapter1/ex1_31.scm: -------------------------------------------------------------------------------- 1 | (define (product term a next b) ; 迭代计算 2 | (define (iter a result) 3 | (if (> a b) 4 | result 5 | (iter (next a) (* result (term a))))) 6 | (iter a 1)) 7 | 8 | ; 利用product计算阶乘 9 | (define (identity x) x) 10 | (define (inc x) (+ x 1)) 11 | (define (factorial n) 12 | (product identity 1 inc n)) 13 | 14 | ; 利用公式pi/4 = (2*4 * 4*6 ...) / (3*3 * 5*5 ...)计算pi 15 | (define (pi-term x) (/ (* (- x 1) (+ x 1)) (square x))) 16 | (define (pi-next x) (+ x 2)) 17 | (define (pi-prod n) 18 | (product pi-term 3 pi-next n)) 19 | 20 | (* 4.0 (pi-prod 1001)) 21 | -------------------------------------------------------------------------------- /chapter1/ex1_38.scm: -------------------------------------------------------------------------------- 1 | (define (cont-frac n d k) ; 迭代计算过程 2 | (define (frac i prev) 3 | (/ (n i) (+ (d i) prev))) 4 | (define (iter i result) 5 | (if (= i 0) 6 | result 7 | (iter (- i 1) (frac i result)))) 8 | (iter k 0)) 9 | 10 | (define (d i) 11 | (define (divide-three? n) (= (remainder n 3) 0)) 12 | (let ((next (+ i 1))) 13 | (cond ((divide-three? next) (* 2 (/ next 3))) 14 | (else 1.0)))) 15 | 16 | ; 无限连分式中, Ni为1, Di为1 2 1 1 4 1 1 6 .... 17 | ; 可以逼近e - 2 18 | (+ 2 (cont-frac (lambda (x) 1.0) 19 | d 20 | 100)) 21 | -------------------------------------------------------------------------------- /chapter2/ex2_1.scm: -------------------------------------------------------------------------------- 1 | (define (gcd a b) 2 | (if (= b 0) 3 | a 4 | (gcd b (remainder a b)))) 5 | 6 | (define (make-rat a b) 7 | (let ((g (gcd a b))) 8 | (if (< (/ b g) 0) 9 | (cons (- 0 (/ a g)) (- 0 (/ b g))) 10 | (cons (/ a g) (/ b g))))) 11 | 12 | (define (numer x) (car x)) 13 | (define (demon x) (cdr x)) 14 | (define (print-rat x) 15 | (newline) 16 | (display (numer x)) 17 | (display "/") 18 | (display (demon x))) 19 | 20 | (print-rat (make-rat 18 -15)) 21 | (print-rat (make-rat -18 -15)) 22 | (print-rat (make-rat -18 15)) 23 | (print-rat (make-rat 18 15)) 24 | -------------------------------------------------------------------------------- /chapter2/ex2_32.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (append list1 list2) 4 | (if (null? list1) 5 | list2 6 | (cons (car list1) (append (cdr list1) list2)))) 7 | 8 | (define (map proc items) 9 | (if (null? items) 10 | nil 11 | (cons (proc (car items)) 12 | (map proc (cdr items))))) 13 | 14 | ; rest表示(cdr s)的元素所能构成的集合列表 15 | ; 将rest和(car s)添加到每一个rest的两个列表组合即可 16 | (define (subsets s) 17 | (if (null? s) 18 | (list nil) 19 | (let ((rest (subsets (cdr s)))) 20 | (append rest (map (lambda (x) (cons (car s) x)) rest))))) 21 | 22 | (subsets (list 1 2 3)) 23 | -------------------------------------------------------------------------------- /chapter1/ex1_19.scm: -------------------------------------------------------------------------------- 1 | (define (fib n) 2 | (define (even? x) (= (remainder x 2) 0)) 3 | (define (fib-iter a b p q n) 4 | (cond ((= 0 n) b) 5 | ((even? n) (fib-iter a 6 | b 7 | (+ (square p) (square q)) 8 | (+ (square q) (* 2 p q)) 9 | (/ n 2))) 10 | (else (fib-iter (+ (* b q) (* a q) (* a p)) 11 | (+ (* b p) (* a q)) 12 | p 13 | q 14 | (- n 1))))) 15 | (fib-iter 1 0 0 1 n)) 16 | -------------------------------------------------------------------------------- /chapter2/ex2_19.scm: -------------------------------------------------------------------------------- 1 | (define us-coins (list 50 25 10 5 1)) 2 | (define cn-coins (list 100 50 20 10 5 1)) 3 | 4 | (define (first-demonination coin-values) 5 | (car coin-values)) 6 | 7 | (define (except-first-demonination coin-values) 8 | (cdr coin-values)) 9 | 10 | (define no-more? null?) 11 | 12 | (define (cc amount coin-values) 13 | (cond ((= amount 0) 1) 14 | ((or (< amount 0) (no-more? coin-values)) 0) 15 | (else 16 | (+ (cc amount 17 | (except-first-demonination coin-values)) 18 | (cc (- amount (first-demonination coin-values)) 19 | coin-values))))) 20 | 21 | (cc 100 us-coins) 22 | -------------------------------------------------------------------------------- /chapter2/ex2_36.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (accumulate op initial sequence) 4 | (if (null? sequence) 5 | initial 6 | (op (car sequence) 7 | (accumulate op initial (cdr sequence))))) 8 | 9 | (define (map p sequence) 10 | (accumulate (lambda (x y) (cons (p x) y)) nil sequence)) 11 | 12 | (define (accumulate-n op init seqs) 13 | (if (null? (car seqs)) 14 | nil 15 | (cons (accumulate op init (map (lambda (x) (car x)) seqs)) 16 | (accumulate-n op init (map (lambda (x) (cdr x)) seqs))))) 17 | 18 | (define m (list (list 1 2 3) 19 | (list 4 5 6) 20 | (list 7 8 9) 21 | (list 10 11 12))) 22 | -------------------------------------------------------------------------------- /chapter2/ex2_39.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (fold-right op init seqs) 4 | (if (null? seqs) 5 | init 6 | (op (car seqs) 7 | (fold-right op init (cdr seqs))))) 8 | 9 | (define (fold-left op init seqs) 10 | (define (iter result rest) 11 | (if (null? rest) 12 | result 13 | (iter (op result (car rest)) 14 | (cdr rest)))) 15 | (iter init seqs)) 16 | 17 | (define (append list1 list2) 18 | (fold-right cons list2 list1)) 19 | 20 | (define (reverse sequence) 21 | (fold-right (lambda (x y) (append y (list x))) nil sequence)) 22 | 23 | (define (reverse2 sequence) 24 | (fold-left (lambda (x y) (cons y x)) nil sequence)) 25 | -------------------------------------------------------------------------------- /chapter2/ex2_34.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (filter predicate sequence) 4 | (cond ((null? sequence) nil) 5 | ((predicate (car sequence)) 6 | (cons (car sequence) 7 | (filter (predicate (cdr sequence))))) 8 | (else (filter predicate (cdr sequence))))) 9 | 10 | (define (accumulate op initial sequence) 11 | (if (null? sequence) 12 | initial 13 | (op (car sequence) 14 | (accumulate op initial (cdr sequence))))) 15 | 16 | (define (horner-eval x conefficient-sequence) 17 | (accumulate (lambda (this-coeff higher-terms) 18 | (+ this-coeff (* x higher-terms))) 19 | 0 20 | conefficient-sequence)) 21 | -------------------------------------------------------------------------------- /chapter1/ex1_36.scm: -------------------------------------------------------------------------------- 1 | (define tolerance 0.0001) 2 | 3 | ; 函数x -> f(x)不动点的逼近方式 4 | ; f(x), f(f(x)), f(f(f(x)))... 5 | (define (fixed-point f first-guess) 6 | (define (close-enough? v1 v2) 7 | (< (abs (- v1 v2)) tolerance)) 8 | (define (try guess k) 9 | (let ((next (f guess))) 10 | (newline) ; 统计计算步数 11 | (display k) 12 | (display "\t") 13 | (display next) 14 | (if (close-enough? guess next) 15 | next 16 | (try next (+ k 1))))) 17 | (try first-guess 1)) 18 | 19 | ; 利用不动点计算x^x=1000的根 20 | (fixed-point (lambda (x) (/ (log 1000) (log x))) 2.0) 21 | 22 | ; 使用平均阻尼,加速收敛 23 | (fixed-point (lambda (x) (/ (+ (/ (log 1000) (log x)) x) 2.0)) 2.0) 24 | -------------------------------------------------------------------------------- /chapter2/ex2_5.scm: -------------------------------------------------------------------------------- 1 | (define (fast-expt b n) 2 | (define (even? x) (= (remainder x 2) 0)) 3 | (define (fast-expt-iter a b n) 4 | (cond ((= n 0) a) 5 | ((even? n) (fast-expt-iter a (square b) (/ n 2))) 6 | (else (fast-expt-iter (* a b) b (- n 1))))) 7 | (fast-expt-iter 1 b n)) 8 | 9 | (define (my-cons a b) (* (fast-expt 2 a) (fast-expt 3 b))) 10 | 11 | ; 效率较低，可用二分答案提升效率 12 | (define (my-car n) 13 | (define (iter a n) 14 | (if (= (remainder n 2) 0) 15 | (iter (+ a 1) (/ n 2)) 16 | a)) 17 | (iter 0 n)) 18 | (define (my-cdr n) 19 | (define (iter b n) 20 | (if (= (remainder n 3) 0) 21 | (iter (+ b 1) (/ n 3)) 22 | b)) 23 | (iter 0 n)) 24 | -------------------------------------------------------------------------------- /chapter2/ex2_10.scm: -------------------------------------------------------------------------------- 1 | (define (make-interval a b) (cons (min a b) (max a b))) 2 | (define (lower-bound z) (car z)) 3 | (define (upper-bound z) (cdr z)) 4 | 5 | (define (print-interval p) 6 | (newline) 7 | (display "(") 8 | (display (lower-bound p)) 9 | (display ",") 10 | (display (upper-bound p)) 11 | (display ")")) 12 | 13 | (define (divide-interval x y) 14 | (if (<= (* (lower-bound y) (upper-bound y)) 0) 15 | (error "divide cross 0!") 16 | (make-interval (/ (lower-bound x) (upper-bound y)) 17 | (/ (upper-bound x) (lower-bound y))))) 18 | 19 | (print-interval (divide-interval (make-interval 4 8) (make-interval 1 3))) 20 | (print-interval (divide-interval (make-interval 4 8) (make-interval -1 1))) 21 | 22 | -------------------------------------------------------------------------------- /chapter2/ex2_33.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (filter predicate sequence) 4 | (cond ((null? sequence) nil) 5 | ((predicate (car sequence)) 6 | (cons (car sequence) 7 | (filter (predicate (cdr sequence))))) 8 | (else (filter predicate (cdr sequence))))) 9 | 10 | (define (accumulate op initial sequence) 11 | (if (null? sequence) 12 | initial 13 | (op (car sequence) 14 | (accumulate op initial (cdr sequence))))) 15 | 16 | ; op中第二项为后面accumulate的结果，一般只需处理第一项 17 | (define (map p sequence) 18 | (accumulate (lambda (x y) (cons (p x) y)) nil sequence)) 19 | 20 | (define (append seq1 seq2) 21 | (accumulate cons seq2 seq1)) 22 | 23 | (define (length sequence) 24 | (accumulate (lambda (x y) (+ 1 y)) 0 sequence)) 25 | -------------------------------------------------------------------------------- /chapter1/ex1_46.scm: -------------------------------------------------------------------------------- 1 | ; 迭代式改进策略 2 | (define (iterative-improve good-enough? improve) 3 | (define (iter guess) 4 | (if (good-enough? guess) 5 | guess 6 | (iter (improve guess)))) 7 | iter) 8 | 9 | (define (sqrt-iter n) 10 | (define (sqrt-improve guess) (/ (+ guess (/ n guess)) 2.0)) 11 | (define (sqrt-good-enough? guess) 12 | (< (/ (abs (- guess (sqrt-improve guess))) guess) 0.001)) 13 | ((iterative-improve sqrt-good-enough? sqrt-improve) 1.0)) 14 | 15 | ; (sqrt-iter 2) 16 | 17 | (define (fixed-point-iter f first-guess) 18 | (define (improve guess) (f guess)) 19 | (define (good-enough? guess) 20 | (< (/ (abs (- guess (improve guess))) guess) 0.001)) 21 | ((iterative-improve good-enough? improve) first-guess)) 22 | 23 | (fixed-point-iter (lambda (x) (+ 1 (/ 1.0 x))) 1.0) 24 | -------------------------------------------------------------------------------- /chapter2/ex2_2.scm: -------------------------------------------------------------------------------- 1 | (define (make-point a b) 2 | (cons a b)) 3 | 4 | (define (x-point p) (car p)) 5 | (define (y-point p) (cdr p)) 6 | 7 | (define (print-point p) 8 | (newline) 9 | (display "(") 10 | (display (x-point p)) 11 | (display ",") 12 | (display (y-point p)) 13 | (display ")")) 14 | 15 | ; 起点和终点表示线段 16 | (define (make-segment x1 y1 x2 y2) 17 | (cons (make-point x1 y1) 18 | (make-point x2 y2))) 19 | 20 | (define (start-segment s) (car s)) 21 | (define (end-segment s) (cdr s)) 22 | 23 | (define (mid-segment s) 24 | (make-point (/ (+ (x-point (start-segment s)) 25 | (x-point (end-segment s))) 26 | 2.0) 27 | (/ (+ (y-point (start-segment s)) 28 | (y-point (end-segment s))) 29 | 2.0))) 30 | 31 | (print-point (mid-segment (make-segment 1 2 3 6))) 32 | -------------------------------------------------------------------------------- /chapter1/ex1_29.scm: -------------------------------------------------------------------------------- 1 | (define (cube x) (* x x x)) 2 | (define (even? x) (= (remainder x 2) 0)) 3 | 4 | (define (sum term a next b) ; 线性递归 5 | (if (> a b) 6 | 0 7 | (+ (term a) 8 | (sum term (next a) next b)))) 9 | 10 | (define (integral f a b dx) 11 | (define (add-dx x) (+ x dx)) 12 | (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) 13 | 14 | ; 辛普森规则计算函数f在范围a和b之间的定积分近似值 15 | ; (h/3) * [y_0+4y_1+2y_2+...+4y_n-1+y_n] 16 | ; h=(b-a)/n, y_k=f(a+kh), n是某个偶数 17 | (define (simpson-integral f a b n) 18 | (define h (/ (- b a) n)) 19 | (define (add-h x) (+ x h)) 20 | (define (simpson-add term a next k n) 21 | (cond ((> k n) 0) 22 | (else (+ (cond ((or (= k n) (= k 0)) (term a)) 23 | ((even? k) (* (term a) 2)) 24 | (else (* (term a) 4))) 25 | (simpson-add term (next a) next (+ k 1) n))))) 26 | (* (simpson-add f a add-h 0 n) (/ h 3.0))) 27 | -------------------------------------------------------------------------------- /chapter1/ex1_30.scm: -------------------------------------------------------------------------------- 1 | (define (cube x) (* x x x)) 2 | (define (even? x) (= (remainder x 2) 0)) 3 | 4 | (define (sum term a next b) ; 迭代计算 5 | (define (iter a result) 6 | (if (> a b) 7 | result 8 | (iter (next a) (+ result (term a))))) 9 | (iter a 0)) 10 | 11 | (define (integral f a b dx) 12 | (define (add-dx x) (+ x dx)) 13 | (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) 14 | 15 | ; 辛普森规则计算函数f在范围a和b之间的定积分近似值 16 | ; (h/3) * [y_0+4y_1+2y_2+...+4y_n-1+y_n] 17 | ; h=(b-a)/n, y_k=f(a+kh), n是某个偶数 18 | (define (simpson-integral f a b n) 19 | (define h (/ (- b a) n)) 20 | (define (add-h x) (+ x h)) 21 | (define (f-iter a k) ; 带迭代计数 22 | (cond ((or (= k n) (= k 0)) (f a)) 23 | ((even? k) (* (f a) 2)) 24 | (else (* (f a) 4)))) 25 | (define (iter a k result) ; 迭代计算 26 | (if (> k n) 27 | result 28 | (iter (add-h a) (+ k 1) (+ result (f-iter a k))))) 29 | (* (iter a 0 0) (/ h 3.0))) 30 | -------------------------------------------------------------------------------- /chapter2/ex2_37.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (accumulate op initial sequence) 4 | (if (null? sequence) 5 | initial 6 | (op (car sequence) 7 | (accumulate op initial (cdr sequence))))) 8 | 9 | ; 对矩阵列进行累计操作 10 | (define (accumulate-n op init seqs) 11 | (if (null? (car seqs)) 12 | nil 13 | (cons (accumulate op init (map (lambda (x) (car x)) seqs)) 14 | (accumulate-n op init (map (lambda (x) (cdr x)) seqs))))) 15 | 16 | ; 这里用到了scheme的标准map，可以接受多个list 17 | (define (dot-product v w) 18 | (accumulate + 0 (map * v w))) 19 | 20 | (define (matrix-*-vector m v) 21 | (map (lambda (x) (dot-product x v)) m)) 22 | 23 | (define (transpose mat) 24 | (accumulate-n cons nil mat)) 25 | 26 | (define (matrix-*-matrix m n) 27 | (let ((cols (transpose n))) 28 | (map (lambda (v) (matrix-*-vector cols v)) m))) 29 | 30 | (define v (list 1 2 3)) 31 | (define w (list 1 3 5)) 32 | (define m (list (list 1 2 3) (list 4 5 6))) 33 | (define n (list (list 1 1 1 1) (list 2 2 2 2) (list 3 3 3 3))) 34 | 35 | -------------------------------------------------------------------------------- /chapter2/ex2_35.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (filter predicate sequence) 4 | (cond ((null? sequence) nil) 5 | ((predicate (car sequence)) 6 | (cons (car sequence) 7 | (filter (predicate (cdr sequence))))) 8 | (else (filter predicate (cdr sequence))))) 9 | 10 | (define (accumulate op initial sequence) 11 | (if (null? sequence) 12 | initial 13 | (op (car sequence) 14 | (accumulate op initial (cdr sequence))))) 15 | 16 | ; op中第二项为后面accumulate的结果，一般只需处理第一项 17 | (define (map p sequence) 18 | (accumulate (lambda (x y) (cons (p x) y)) nil sequence)) 19 | 20 | (define (append seq1 seq2) 21 | (accumulate cons seq2 seq1)) 22 | 23 | (define (length sequence) 24 | (accumulate (lambda (x y) (+ 1 y)) 0 sequence)) 25 | 26 | ; 用accumulate递归实现count-leaves 27 | (define (count-leaves t) 28 | (accumulate + 0 (map (lambda (x) 29 | (if (pair? x) 30 | (count-leaves x) 31 | 1)) 32 | t))) 33 | -------------------------------------------------------------------------------- /chapter1/ex1_22.scm: -------------------------------------------------------------------------------- 1 | (define (find-divisor n test-divisor) 2 | (define (divides? a b) (= (remainder b a) 0)) 3 | (cond ((> (square test-divisor) n) n) 4 | ((divides? test-divisor n) test-divisor) 5 | (else (find-divisor n (+ test-divisor 1))))) 6 | (define (smallest-divisor n) 7 | (find-divisor n 2)) 8 | (define (prime? n) 9 | (= n (smallest-divisor n))) 10 | 11 | (define (report-prime elasped-time) 12 | (display " *** ") 13 | (display elasped-time) 14 | true) 15 | (define (start-prime-test n start-time) 16 | (if (prime? n) 17 | (report-prime (- (runtime) start-time)) 18 | false)) 19 | (define (timed-prime-test n) 20 | (newline) 21 | (display n) 22 | (start-prime-test n (runtime))) 23 | 24 | (define (search-for-primes n count) 25 | (define (even? x) (= (remainder x 2) 0)) 26 | (define (next x) 27 | (cond ((even? x) (+ x 1)) 28 | (else (+ x 2)))) 29 | (if (> count 0) 30 | (if (timed-prime-test n) 31 | (search-for-primes (next n) (- count 1)) 32 | (search-for-primes (next n) count))) 33 | true) 34 | -------------------------------------------------------------------------------- /chapter1/ex1_40.scm: -------------------------------------------------------------------------------- 1 | (define tolerance 0.0001) 2 | 3 | ; 函数x -> f(x)不动点的逼近方式 4 | ; f(x), f(f(x)), f(f(f(x)))... 5 | (define (fixed-point f first-guess) 6 | (define (close-enough? v1 v2) 7 | (< (abs (- v1 v2)) tolerance)) 8 | (define (try guess k) 9 | (let ((next (f guess))) 10 | (newline) ; 统计计算步数 11 | (display k) 12 | (display "\t") 13 | (display next) 14 | (if (close-enough? guess next) 15 | next 16 | (try next (+ k 1))))) 17 | (try first-guess 1)) 18 | 19 | ; deriv求函数g的导数 20 | (define dx 0.00001) 21 | (define (deriv g) 22 | (lambda (x) (/ (- (g (+ x dx)) (g x)) dx))) 23 | 24 | ; 逼近序列 x_n+1 = x_n - g(x_n) / Dg(x_n) 25 | ; 求逼近序列的不动点即为g(x)=0的解 26 | (define (newton-transform g) 27 | (lambda (x) (- x (/ (g x) ((deriv g) x))))) 28 | (define (newton-method g guess) 29 | (fixed-point (newton-transform g) guess)) 30 | 31 | ; cubic函数 x^3+ax^2+bx+c 32 | (define (cubic a b c) 33 | (lambda (x) (+ (* x x x) 34 | (* a (square x)) 35 | (* b x) 36 | c))) 37 | 38 | ; 牛顿法求x^3+x^2+2x+3=0的根 39 | (newton-method (cubic 1 2 3) 1.0) 40 | -------------------------------------------------------------------------------- /chapter2/ex2_27.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (reverse n) 4 | (define (reverse-iter n l) 5 | (if (null? n) 6 | l 7 | (reverse-iter (cdr n) (cons (car n) l)))) 8 | (if (null? n) 9 | nil 10 | (reverse-iter (cdr n) (list (car n))))) ; 用list在第一个元素后面加nil 11 | 12 | ; 在reverse实现的基础上，对car items进行deep-reverse即可 13 | ; 注意car items可能为值类型，要用pair?进行判断 14 | (define (deep-reverse items) 15 | (define (reverse-iter items result) 16 | (cond ((null? items) 17 | result) 18 | ((not (pair? (car items))) 19 | (reverse-iter (cdr items) (cons (car items) result))) 20 | (else 21 | (reverse-iter (cdr items) (cons (deep-reverse (car items)) result))))) 22 | (cond ((null? items) nil) 23 | ((not (pair? (car items))) 24 | (reverse-iter (cdr items) (list (car items)))) 25 | (else 26 | (reverse-iter (cdr items) (list (deep-reverse (car items))))))) 27 | 28 | 29 | ; (reverse (list (list 1 2) (list 3 4) (list 5 6))) 30 | ; (reverse (list (list 1 (list 2 3)) (list 4 (list 5 6)))) 31 | ; (deep-reverse (list (list 1 2) (list 3 4) (list 5 6))) 32 | ; (deep-reverse (list (list 1 (list 2 3)) (list 4 (list 5 6)))) 33 | -------------------------------------------------------------------------------- /chapter2/ex2_41.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (accumulate op init seqs) 4 | (if (null? seqs) 5 | init 6 | (op (car seqs) 7 | (accumulate op init (cdr seqs))))) 8 | 9 | (define (map proc seq) 10 | (accumulate (lambda (x y) (cons (proc x) y)) nil seq)) 11 | 12 | (define (append list1 list2) 13 | (accumulate cons list2 list1)) 14 | 15 | (define (enumerate-interval x y) 16 | (if (> x y) 17 | nil 18 | (cons x (enumerate-interval (+ x 1) y)))) 19 | 20 | (define (flatmap proc seq) 21 | (accumulate append nil (map proc seq))) 22 | 23 | (define (filter predicate sequence) 24 | (cond ((null? sequence) nil) 25 | ((predicate (car sequence)) 26 | (cons (car sequence) 27 | (filter predicate (cdr sequence)))) 28 | (else (filter predicate (cdr sequence))))) 29 | 30 | (define (unique-pairs n) 31 | (flatmap (lambda (x) (map (lambda (i) (list x i)) 32 | (enumerate-interval 1 (- x 1)))) 33 | (enumerate-interval 1 n))) 34 | 35 | (define (triple-pairs n) 36 | (flatmap (lambda (x) (map (lambda (i) (cons x i)) 37 | (unique-pairs (- x 1)))) 38 | (enumerate-interval 1 n))) 39 | 40 | (define (triple-sum n s) 41 | (filter (lambda (t) (= s (+ (car t) (cadr t) (caddr t)))) 42 | (triple-pairs n))) 43 | 44 | -------------------------------------------------------------------------------- /chapter2/ex2_29.scm: -------------------------------------------------------------------------------- 1 | (define (make-mobile left right) 2 | (list left right)) 3 | 4 | (define (left-branch mobile) 5 | (car mobile)) 6 | 7 | (define (right-branch mobile) 8 | (car (cdr mobile))) 9 | 10 | (define (make-branch length structure) 11 | (list length structure)) 12 | 13 | (define (branch-length branch) 14 | (car branch)) 15 | 16 | (define (branch-structure branch) 17 | (car (cdr branch))) 18 | 19 | (define (total-weight mobile) 20 | (if (not (pair? mobile)) 21 | mobile 22 | (+ (total-weight (branch-structure (left-branch mobile))) 23 | (total-weight (branch-structure (right-branch mobile)))))) 24 | 25 | (define (balance? mobile) 26 | (if (not (pair? mobile)) 27 | true 28 | (and (balance? (branch-structure (left-branch mobile))) 29 | (balance? (branch-structure (right-branch mobile))) 30 | (= (* (total-weight (branch-structure (left-branch mobile))) 31 | (branch-length (left-branch mobile))) 32 | (* (total-weight (branch-structure (right-branch mobile))) 33 | (branch-length (right-branch mobile))))))) 34 | 35 | (define m (make-mobile (make-branch 2 (make-mobile (make-branch 3 2) 36 | (make-branch 1 6))) 37 | (make-branch 4 4))) 38 | ; (balance? (make-mobile (make-branch 1 1) (make-branch 2 2))) 39 | -------------------------------------------------------------------------------- /chapter1/ex1_24.scm: -------------------------------------------------------------------------------- 1 | (define (even? x) (= (remainder x 2) 0)) 2 | 3 | ; 计算一个数的幂对另一个数取模 4 | ; 算法类似求幂的二分递归 5 | (define (expmod base exp m) 6 | (cond ((= exp 0) 1) 7 | ((even? exp) 8 | (remainder (square (expmod base (/ exp 2) m)) m)) 9 | (else 10 | (remainder (* base (expmod base (- exp 1) m)) m)))) 11 | 12 | ; 费马小定理，若n为素数，a count 0) 42 | (if (timed-prime-test n) 43 | (search-for-primes (next n) (- count 1)) 44 | (search-for-primes (next n) count))) 45 | true) 46 | -------------------------------------------------------------------------------- /chapter1/ex1_45.scm: -------------------------------------------------------------------------------- 1 | ; fixed-point计算不动点 2 | (define tolerance 0.0001) 3 | (define (fixed-point f first-guess) 4 | (define (close-enough? v1 v2) 5 | (< (abs (- v1 v2)) tolerance)) 6 | (define (try guess k) 7 | (let ((next (f guess))) 8 | (newline) ; 统计计算步数 9 | (display k) 10 | (display "\t") 11 | (display next) 12 | (if (close-enough? guess next) 13 | next 14 | (try next (+ k 1))))) 15 | (try first-guess 1)) 16 | 17 | ; average-damp对函数进行一次平均阻尼转换 18 | (define (average a b) (/ (+ a b) 2.0)) 19 | (define (average-damp f) 20 | (lambda (x) (average x (f x)))) 21 | 22 | ; repeated将函数施加n次 23 | (define (compose f g) 24 | (lambda (x) (f (g x)))) 25 | (define (repeated f n) 26 | (if (= n 1) 27 | f 28 | (compose f (repeated f (- n 1))))) 29 | 30 | ; 迭代计算求幂 31 | (define (fast-expt b n) 32 | (define (even? x) (= (remainder x 2) 0)) 33 | (define (fast-expt-iter a b n) 34 | (cond ((= n 0) a) 35 | ((even? n) (fast-expt-iter a (square b) (/ n 2))) 36 | (else (fast-expt-iter (* a b) b (- n 1))))) 37 | (fast-expt-iter 1 b n)) 38 | 39 | ; 求n次方根,进行k次平均阻尼 40 | ; 等价求 y -> x/y^(n-1) 的不动点 41 | (define (root-n-test x n k) 42 | (fixed-point ((repeated average-damp k) (lambda (y) (/ x (fast-expt y (- n 1))))) 1.0)) 43 | 44 | ; 求n次方根,进行n-1次平均阻尼（最佳） 45 | (define (root-n x n) 46 | (fixed-point ((repeated average-damp (- n 1)) (lambda (y) (/ x (fast-expt y (- n 1))))) 1.0)) 47 | 48 | -------------------------------------------------------------------------------- /chapter1/ex1_33.scm: -------------------------------------------------------------------------------- 1 | (define (filtered-accumulate combiner filter null-value term a next b) ; 迭代计算过程 2 | (define (iter a result) 3 | (cond ((> a b) result) 4 | ((filter a) (iter (next a) (combiner (term a) result))) 5 | (else (iter (next a) result)))) 6 | (iter a null-value)) 7 | 8 | (define (even? x) (= (remainder x 2) 0)) 9 | 10 | ; 计算一个数的幂对另一个数取模 11 | ; 算法类似求幂的二分递归 12 | (define (expmod base exp m) 13 | (cond ((= exp 0) 1) 14 | ((even? exp) 15 | (remainder (square (expmod base (/ exp 2) m)) m)) 16 | (else 17 | (remainder (* base (expmod base (- exp 1) m)) m)))) 18 | 19 | ; 费马小定理，若n为素数，a= x1 0) 20 | (cond ((>= y1 0) (make-interval (* x1 y1) (* x2 y2))) 21 | ((<= y2 0) (make-interval (* x2 y1) (* x1 y2))) 22 | (else (make-interval (* x2 y1) (* x2 y2))))) 23 | ((<= x2 0) 24 | (cond ((>= y1 0) (make-interval (* x1 y2) (* x2 y1))) 25 | ((<= y2 0) (make-interval (* x2 y2) (* x1 y1))) 26 | (else (make-interval (* x1 y2) (* x1 y1))))) 27 | (else 28 | (cond ((>= y1 0) (make-interval (* x1 y2) (* x2 y2))) 29 | ((<= y2 0) (make-interval (* x2 y1) (* x1 y1))) 30 | (else (make-interval (min (* x1 y2) (* x2 y1)) (max (* x2 y2) (* x1 y1))))))))) 31 | 32 | (print-interval (mul-interval (make-interval 4 8) (make-interval 1 3))) 33 | (print-interval (mul-interval (make-interval 4 8) (make-interval -3 -1))) 34 | (print-interval (mul-interval (make-interval 4 8) (make-interval -1 3))) 35 | (print-interval (mul-interval (make-interval -8 -4) (make-interval 1 3))) 36 | (print-interval (mul-interval (make-interval -8 -4) (make-interval -3 -1))) 37 | (print-interval (mul-interval (make-interval -8 -4) (make-interval -1 3))) 38 | (print-interval (mul-interval (make-interval -4 8) (make-interval 1 3))) 39 | (print-interval (mul-interval (make-interval -4 8) (make-interval -3 -1))) 40 | (print-interval (mul-interval (make-interval -4 8) (make-interval -1 3))) 41 | -------------------------------------------------------------------------------- /chapter2/ex2_40.scm: -------------------------------------------------------------------------------- 1 | (define nil ()) 2 | 3 | (define (accumulate op init seqs) 4 | (if (null? seqs) 5 | init 6 | (op (car seqs) 7 | (accumulate op init (cdr seqs))))) 8 | 9 | (define (map proc seq) 10 | (accumulate (lambda (x y) (cons (proc x) y)) nil seq)) 11 | 12 | (define (append list1 list2) 13 | (accumulate cons list2 list1)) 14 | 15 | (define (enumerate-interval x y) 16 | (if (> x y) 17 | nil 18 | (cons x (enumerate-interval (+ x 1) y)))) 19 | 20 | (define (flatmap proc seq) 21 | (accumulate append nil (map proc seq))) 22 | 23 | ; 计算一个数的幂对另一个数取模 24 | ; 算法类似求幂的二分递归 25 | (define (expmod base exp m) 26 | (cond ((= exp 0) 1) 27 | ((even? exp) 28 | (remainder (square (expmod base (/ exp 2) m)) m)) 29 | (else 30 | (remainder (* base (expmod base (- exp 1) m)) m)))) 31 | 32 | ; 费马小定理，若n为素数，a x y) 17 | nil 18 | (cons x (enumerate-interval (+ x 1) y)))) 19 | 20 | (define (flatmap proc seq) 21 | (accumulate append nil (map proc seq))) 22 | 23 | (define (filter predicate sequence) 24 | (cond ((null? sequence) nil) 25 | ((predicate (car sequence)) 26 | (cons (car sequence) 27 | (filter predicate (cdr sequence)))) 28 | (else (filter predicate (cdr sequence))))) 29 | 30 | (define (adjoin-position new-row k rest-of-queens) 31 | (cons new-row rest-of-queens)) 32 | 33 | (define empty-board nil) 34 | 35 | (define (safe? k position) 36 | (define (iter row-k i position) 37 | (cond ((= 0 i) true) 38 | ((or (= (car position) row-k) 39 | (= (- k i) (abs (- row-k (car position))))) 40 | false) 41 | (else (iter row-k (- i 1) (cdr position))))) 42 | (iter (car position) (- k 1) (cdr position))) 43 | 44 | (define (queens board-size) 45 | (define (queens-cols k) 46 | (if (= k 0) 47 | (list empty-board) 48 | (filter 49 | (lambda (position) (safe? k position)) 50 | (flatmap ; 针对当前可行布局扩展第k+1列 51 | (lambda (rest-of-queens) ; rest-of-queens是一个k列的可行布局 52 | (map (lambda (new-row) ; new-row是第k+1列的一个新尝试 53 | (adjoin-position new-row k rest-of-queens)) 54 | (enumerate-interval 1 board-size))) ; 对所有1到board-size行都进行尝试 55 | (queens-cols (- k 1)))))) 56 | (queens-cols board-size)) 57 | -------------------------------------------------------------------------------- /chapter2/ex2_3.scm: -------------------------------------------------------------------------------- 1 | (define (make-point a b) 2 | (cons a b)) 3 | 4 | (define (x-point p) (car p)) 5 | (define (y-point p) (cdr p)) 6 | (define (equal-point? p1 p2) 7 | (and (= (x-point p1) (x-point p2)) 8 | (= (y-point p1) (y-point p2)))) 9 | 10 | (define (print-point p) 11 | (newline) 12 | (display "(") 13 | (display (x-point p)) 14 | (display ",") 15 | (display (y-point p)) 16 | (display ")")) 17 | 18 | ; 起点和终点表示线段 19 | (define (make-segment x1 y1 x2 y2) 20 | (cons (make-point x1 y1) 21 | (make-point x2 y2))) 22 | 23 | (define (start-segment s) (car s)) 24 | (define (end-segment s) (cdr s)) 25 | 26 | ; 用两条线段表示矩形, start-segment要求一样, 且点积为0(直角) 27 | (define (rect-segment s1 s2) 28 | (define (cross x1 y1 x2 y2) 29 | (+ (* x1 x2) (* y1 y2))) 30 | (let ((x1 (x-point (start-segment s1))) 31 | (x2 (x-point (end-segment s1))) 32 | (x3 (x-point (end-segment s2))) 33 | (y1 (y-point (start-segment s1))) 34 | (y2 (y-point (end-segment s1))) 35 | (y3 (y-point (end-segment s2)))) 36 | (cond ((not (equal-point? (start-segment s1) 37 | (start-segment s2))) 38 | (error "different start point!")) 39 | ((not (= (cross (- x2 x1) (- y2 y1) (- x3 x1) (- y3 y1)) 0)) 40 | (error "not a rectangular!")) 41 | (else (cons s1 s2))))) 42 | 43 | ; rect-width和rect-height作为抽象屏障 44 | ; 不同的矩阵实现都通过实现这两个函数来求面积和周长 45 | (define (rect-width r) 46 | (let ((s1 (car r))) 47 | (let ((x1 (x-point (start-segment s1))) 48 | (x2 (x-point (end-segment s1))) 49 | (y1 (y-point (start-segment s1))) 50 | (y2 (y-point (end-segment s1)))) 51 | (sqrt (+ (square (- x2 x1)) (square (- y2 y1))))))) 52 | 53 | (define (rect-height r) 54 | (let ((s1 (cdr r))) 55 | (let ((x1 (x-point (start-segment s1))) 56 | (x2 (x-point (end-segment s1))) 57 | (y1 (y-point (start-segment s1))) 58 | (y2 (y-point (end-segment s1)))) 59 | (sqrt (+ (square (- x2 x1)) (square (- y2 y1))))))) 60 | 61 | (define (rect-area r) 62 | (* (rect-width r) (rect-height r))) 63 | (define (rect-length r) 64 | (* (+ (rect-width r) (rect-height r)) 2)) 65 | 66 | (define r1 (rect-segment (make-segment 0 0 1 1) (make-segment 0 0 2 -2))) 67 | (rect-area r1) 68 | (rect-length r1) 69 | -------------------------------------------------------------------------------- /chapter2/ex2_49.scm: -------------------------------------------------------------------------------- 1 | (require (lib "racket/draw")) 2 | (require racket/class) 3 | 4 | (define target (make-bitmap 100 100)) 5 | (define dc (new bitmap-dc% [bitmap target])) 6 | 7 | (define (make-vect x y) (cons x y)) 8 | (define (xcor-vect v) (car v)) 9 | (define (ycor-vect v) (cdr v)) 10 | 11 | (define (add-vect v1 v2) 12 | (make-vect (+ (xcor-vect v1) (xcor-vect v2)) 13 | (+ (ycor-vect v1) (ycor-vect v2)))) 14 | 15 | (define (sub-vect v1 v2) 16 | (make-vect (- (xcor-vect v1) (xcor-vect v2)) 17 | (- (ycor-vect v1) (ycor-vect v2)))) 18 | 19 | (define (scale-vect s v) 20 | (make-vect (* s (xcor-vect v)) 21 | (* s (ycor-vect v)))) 22 | 23 | (define (make-segment start end) (cons start end)) 24 | (define (start-segment s) (car s)) 25 | (define (end-segment s) (cdr s)) 26 | 27 | (define (make-frame origin edge1 edge2) 28 | (list origin edge1 edge2)) 29 | 30 | (define (origin-frame f) (car f)) 31 | (define (edge1-frame f) (cadr f)) 32 | (define (edge2-frame f) (caddr f)) 33 | 34 | (define (frame-coord-map frame) 35 | (lambda (v) 36 | (add-vect 37 | (origin-frame frame) 38 | (add-vect (scale-vect (xcor-vect v) (edge1-frame frame)) 39 | (scale-vect (ycor-vect v) (edge2-frame frame)))))) 40 | 41 | (define (drawline start end) 42 | (send dc draw-line (xcor-vect start) (ycor-vect start) 43 | (xcor-vect end) (ycor-vect end))) 44 | 45 | (define (segments-painter segment-list) 46 | (lambda (frame) 47 | (for-each 48 | (lambda (segment) 49 | (drawline 50 | ((frame-coord-map frame) (start-segment segment)) 51 | ((frame-coord-map frame) (end-segment segment)))) 52 | segment-list))) 53 | 54 | (define (draw-frame-edge frame) 55 | (let ((v1 (origin-frame frame)) 56 | (v2 (add-vect (origin-frame frame) (edge1-frame frame))) 57 | (v3 (add-vect (origin-frame frame) (edge2-frame frame))) 58 | (v4 (add-vect (add-vect (origin-frame frame) 59 | (edge1-frame frame)) 60 | (edge2-frame frame)))) 61 | (drawline v1 v2) 62 | (drawline v1 v3) 63 | (drawline v2 v4) 64 | (drawline v3 v4))) 65 | 66 | (draw-frame-edge (make-frame (make-vect 10 10) (make-vect 30 0) (make-vect 0 60))) 67 | (send target save-file "ex.png" 'png) 68 | -------------------------------------------------------------------------------- /chapter2/ex2_14.scm: -------------------------------------------------------------------------------- 1 | (define (make-interval a b) (cons (min a b) (max a b))) 2 | (define (lower-bound z) (car z)) 3 | (define (upper-bound z) (cdr z)) 4 | 5 | (define (make-center-percent c p) 6 | (make-interval (- c (* c p)) (+ c (* c p)))) 7 | 8 | (define (center i) 9 | (/ (+ (lower-bound i) (upper-bound i)) 2)) 10 | 11 | (define (width i) 12 | (/ (- (upper-bound i) (lower-bound i)) 2)) 13 | 14 | (define (percent i) 15 | (/ (width i) (center i))) 16 | 17 | (define (add-interval x y) 18 | (make-interval (+ (lower-bound x) (lower-bound y)) 19 | (+ (upper-bound x) (upper-bound y)))) 20 | 21 | (define (sub-interval x y) 22 | (make-interval (- (lower-bound x) (upper-bound y)) 23 | (- (upper-bound x) (lower-bound y)))) 24 | 25 | (define (div-interval x y) 26 | (if (<= (* (lower-bound y) (upper-bound y)) 0) 27 | (error "divide cross 0!") 28 | (make-interval (/ (lower-bound x) (upper-bound y)) 29 | (/ (upper-bound x) (lower-bound y))))) 30 | 31 | (define (mul-interval x y) 32 | (let ((x1 (lower-bound x)) 33 | (x2 (upper-bound x)) 34 | (y1 (lower-bound y)) 35 | (y2 (upper-bound y))) 36 | (cond ((>= x1 0) 37 | (cond ((>= y1 0) (make-interval (* x1 y1) (* x2 y2))) 38 | ((<= y2 0) (make-interval (* x2 y1) (* x1 y2))) 39 | (else (make-interval (* x2 y1) (* x2 y2))))) 40 | ((<= x2 0) 41 | (cond ((>= y1 0) (make-interval (* x1 y2) (* x2 y1))) 42 | ((<= y2 0) (make-interval (* x2 y2) (* x1 y1))) 43 | (else (make-interval (* x1 y2) (* x1 y1))))) 44 | (else 45 | (cond ((>= y1 0) (make-interval (* x1 y2) (* x2 y2))) 46 | ((<= y2 0) (make-interval (* x2 y1) (* x1 y1))) 47 | (else (make-interval (min (* x1 y2) (* x2 y1)) (max (* x2 y2) (* x1 y1))))))))) 48 | 49 | (define (print-interval p) 50 | (newline) 51 | (display (center p)) 52 | (display "+-") 53 | (display (* 100 (percent p))) 54 | (display "%")) 55 | 56 | (define (par1 r1 r2) 57 | (div-interval (mul-interval r1 r2) 58 | (add-interval r1 r2))) 59 | 60 | (define (par2 r1 r2) 61 | (let ((one (make-interval 1 1))) 62 | (div-interval one 63 | (add-interval (div-interval one r1) 64 | (div-interval one r2))))) 65 | 66 | (print-interval (par1 (make-center-percent 3 0.01) (make-center-percent 5 0.02))) 67 | (print-interval (par2 (make-center-percent 3 0.01) (make-center-percent 5 0.02))) 68 | --------------------------------------------------------------------------------