《函数程序设计算法》读书笔记。
列表映射
(define square (lambda (x) (* x x)))(define (sum-of-squares . nums)
(apply + (map square nums)))(sum-of-squares 3 4)25(define f (lambda (x) (+ x 1)))(map f (list 1 2 3 4 5))(2 3 4 5 6)(define (sum-of-cubes . nums)
(apply + (map * nums nums nums)))(sum-of-cubes 1 2 3)36(define (sum-of-cubes . nums)
(apply + (map (lambda (nums)
(* nums nums nums))
nums)))(sum-of-cubes 1 2 3)36常量过程
(define (values? . ignored)
#t)(values? 1)#t(define (constant v) (lambda ignored v))(define hey-kid (constant "Why?"))(hey-kid "Don't put your gum in the electrical outlet.")"Why?"(hey-kid "It's gross, and you'll get a shock.")"Why?"(hey-kid "The gum is wet. There's an electrical current.")"Why?"(hey-kid "Just don't do it. okay?")"Why?"(define len (lambda (ls)
(apply + (map (constant 1) ls))))(len (list 3 2 3 4 7))5(length (list 3 2 3 4 4)) ; built-in5过程节选
(define (invoke procedure . args)
(apply procedure args))(invoke + 1 2 3)6(define power-of-two
(lambda (power) (expt 2 power)))(power-of-two 10)1024.0(define (curry procedure)
(lambda (initial)
(lambda remaining
(apply procedure
(append (list initial) remaining)))))(define equal-to? (curry equal?))(equal-to? 2)#<procedure>((equal-to? 2) (+ 1 3))#f((equal-to? 2) (+ 1 1))#t耦合器
(define (compose outer inner)
(lambda args
(let ((intermediates (apply inner args)))
(apply outer (list intermediates)))))(define (pipe earlier later)
(lambda args
(let ((intermediates (apply earlier args)))
(apply later (list intermediates)))))(pipe + power-of-two)#<procedure>((pipe + power-of-two) 3 5)256.0((compose power-of-two +) 3 5)256.0(define (cross . procedures)
(lambda args
(map invoke procedures args)))(define add1 ((curry +) 1))
(define sub1 ((curry +) -1))
(define transfer-unit (cross sub1 add1))(transfer-unit 861 19)(860 20)(define (sect1 f x)
(lambda (y)
(f x y)))
(define (sect2 f y)
(lambda (x)
(f x y)))
(define (dispatch . procedures)
(lambda args
(map (sect2 apply args) procedures)))((dispatch + *) 3 4)(7 12)(define (unwrap-apply f) (lambda (args) (apply f args)))((unwrap-apply +) (list 2 3 4))9((pipe (dispatch + *) (unwrap-apply <)) 3 4)#t((pipe (dispatch + *) (unwrap-apply <)) 1 2)#f适配器
(define (>initial initial . ignored)
initial)(define (>next initial next . ignored)
next)(>initial 1 2 3) ; > means 'keep'1(>initial 0 #t '())0(transfer-unit 861 19)(860 20)((pipe transfer-unit (unwrap-apply >initial)) 861 19)860(define (>all-but-initial initial . others) others)((pipe transfer-unit (unwrap-apply >all-but-initial)) 861 19)(20)(define (identity something) something)(identity 2333)2333(define (>exch initial next . others)
(append (list next initial) others))(>exch 1 2)(2 1)(define (echo . args) (display args))(define (converse f) (pipe >exch (unwrap-apply f)))(expt 3 5)243.0((converse expt) 3 5)125.0(define (~initial procedure)
(lambda (initial . others)
(cons (procedure initial) others)))(~initial (sect2 * 3))#<procedure>((~initial (sect2 * 3)) 3 4 5 6)(9 4 5 6)(define (~next procedure)
(lambda (initial next . others)
(cons initial (cons (procedure next) others))))(~next (sect2 * 3))#<procedure>((~next (sect2 * 3)) 3 4 5 6)(3 12 5 6)(define (~each f)
(lambda args
(map f args)))(~each (sect2 * 3))#<procedure>((~each (sect2 * 3)) 3 4 5 6)(9 12 15 18)(define sum-of-squares (pipe (~each square) (unwrap-apply +)))(sum-of-squares 3 4 5 6)86(define (compare-by pre comparer)
(pipe (~each pre) (unwrap-apply comparer)))递归管理器
(define (recur base? terminal simplify integrate)
(define (recurrer guide)
(if (base? guide)
(terminal guide)
(let* ((res (simplify guide))
(current (car res))
(next (cadr res))
(recursive-results (recurrer next)))
(apply integrate (list current recursive-results)))))
recurrer)((dispatch identity sub1) 3)(3 2)(define factorial (recur zero? (constant 1) (dispatch identity sub1) *))(factorial 5)120(define (build base? terminal derive simplify integrate)
(define (builder . guides)
(if (apply base? guides)
(apply terminal guides)
(let* ((recursive-results
(apply (pipe simplify (unwrap-apply builder)) guides)))
(apply integrate (list (apply derive guides) recursive-results)))))
builder)(define (wrap . args) args)(define factorial2
(build (lambda (a b)
(and (<= a 1) (<= b 1)))
(constant (list 1 1))
wrap
(lambda (a b) (list (max (sub1 a) 1) (max (sub1 b) 1)))
(lambda (x y) (list (* (car x) (car y)) (* (cadr x) (cadr y))))))(factorial2 3 5)(6 120)(factorial2 7 2)(5040 2)(factorial2 0 0)(1 1)(factorial2 1 0)(1 1)(null? '())#t(sum (list 3 4))7(length (list 3 4))2(define (wrap . args) args)
(define arithmetic-mean (pipe (pipe wrap (dispatch sum length)) (unwrap-apply /)))(arithmetic-mean 3 5)4(arithmetic-mean 1 2 3)2(arithmetic-mean 1 10 100)37(arithmetic-mean 1 2 1.5)1.5(constant 1)#<procedure>((constant 1))1((constant 1) 'others)1(length (list))0(define halve (sect2 div 2))(halve 20)10(halve 5)2(define (power-of-two? candidate)
(or (= candidate 1)
(and (even? candidate)
(power-of-two? (halve candidate)))))(power-of-two? 2048)#t(power-of-two? 4860)#f(define (check stop? continue? step)
(define (checker . args)
(or (apply stop? args)
(and (apply continue? args)
(apply (pipe step checker) args))))
checker)(define power-of-two? (check (sect2 = 1) even? halve))(power-of-two? 2048)#t(power-of-two? 4860)#f(define (iterate stop? step)
(define (iterator . args)
(if (apply stop? args)
args
(apply (pipe step iterator) args)))
iterator)(define greatest-odd-divisor (iterate odd? halve))(greatest-odd-divisor 24)(3)(define double (sect1 * 2))(((lambda (bound)
(iterate (unwrap-apply (pipe >initial (sect2 >= bound)))
(unwrap-apply (cross double add1)))) 23) '(1 0))((32 5))(define (ceiling-of-log-two bound)
((pipe (iterate (unwrap-apply (pipe >initial (sect2 >= bound)))
(unwrap-apply (cross double add1)))
(unwrap-apply (unwrap-apply >next)))
'(1 0)))(ceiling-of-log-two 23)5(ceiling-of-log-two 32)5(ceiling-of-log-two 8)3(ceiling-of-log-two 34)6(define (ceiling-of-log-two bound)
(define (doubler most-recent-double count)
(if (>= most-recent-double bound)
count
(doubler (double most-recent-double) (add1 count))))
(doubler 1 0))(ceiling-of-log-two 34)6辗转相除法
mod#<procedure>(define divisible-by? (pipe mod zero?))(divisible-by? 60 2)#t(divisible-by? 60 7)#f(define lesser (lambda (x y) (if (< x y) x y)))(define (greatest-common-divisor left right) ; brute-force
(let ((divides-both? (lambda (candidate)
(and (divisible-by? left candidate)
(divisible-by? right candidate)))))
((iterate divides-both? sub1) (lesser left right))))(greatest-common-divisor 20 12)(4)((dispatch >next mod) 3 4)(4 3)((lambda (arg) ((dispatch >next mod) (car arg) (cadr arg))) '(12 20))(20 12)((iterate (unwrap-apply divisible-by?)
(unwrap-apply (dispatch >next mod)))
'(20 12))((8 4))(define (greater-and-lesser l r)
(if (< l r)
(list r l)
(list l r)))(greater-and-lesser 3 4)(4 3)(greater-and-lesser 4 3)(4 3)(greater-and-lesser 0 0)(0 0)(define greatest-common-divisor
(pipe greater-and-lesser
(pipe (iterate (unwrap-apply divisible-by?)
(unwrap-apply (dispatch >next mod)))
(unwrap-apply (unwrap-apply >next)))))(greatest-common-divisor 12 20)4(greatest-common-divisor 120 270)30(greatest-common-divisor 270 120)30高阶布尔过程
(define (^not condition-met?)
(pipe condition-met? not))((^not zero?) 3)#t((^not zero?) 0)#f((^not zero?) 0)#f(define (^et left-condition-met? right-condition-met?)
(lambda args
(and (apply left-condition-met? args)
(apply right-condition-met? args))))((^et number? even?) 3)#f((^et zero? even?) 4)#f((^et zero? even?) 0)#t(define (^vel left-condition-met? right-condition-met?)
(lambda args
(or (apply left-condition-met? args)
(apply right-condition-met? args))))((^vel zero? odd?) 0)#t((^vel zero? odd?) 1)#t((^vel zero? odd?) 2)#f(define (^if condition-met? consequent alternate)
(lambda args
(if (apply condition-met? args)
(apply consequent args)
(apply alternate args))))(define disparity (^if < (converse -) -))(disparity 588 920)332(disparity 920 588)332(define (conditionally-combine combine? combiner)
(lambda (initial . others)
(if (combine? initial)
(list (apply combiner (cons initial others)))
others)))((conditionally-combine odd? +) 1 2)(3)((conditionally-combine odd? +) 2 2)(2)
