首页 > 代码库 > SICP -- Building Abstractions With Procedures
SICP -- Building Abstractions With Procedures
;; Building Abstractions With Procedures
( define ( my-sqrt x )
( define ( good-enough? guess )
( < ( abs ( - ( square guess ) x ) ) 0.001 ) )
( define ( improve guess )
( average guess ( / x guess ) ) )
( define ( sqrt-iter guess )
( if ( good-enough? guess )
guess
( sqrt-iter ( improve guess ) ) ) )
( sqrt-iter 1.0 ) )
;; fac
( define ( fac n )
( if ( = n 1 ) 1
( * n ( fac ( - n 1 ) ) ) ) )
( define ( fac1 n )
( define ( fac-iter product counter )
( if ( > counter n ) product
( fac-iter ( * counter product )
( + counter 1 ) ) ) )
( fac-iter 1 1 ) )
;; Ackerman
( define ( Ackerman x y )
( cond ( ( = y 0 ) 0 )
( ( = x 0 ) ( * 2 y ) )
( ( = y 1 ) 2 )
( else ( Ackerman ( - x 1 )
( Ackerman x ( - y 1 ) ) ) ) ) )
;; Fibonacci
( define ( fib n )
( cond ( ( = n 0 ) 0 )
( ( = n 1 ) 1 )
( else ( + ( fib ( - n 1 ) )
( fib ( - n 2 ) ) ) ) ) )
( define ( fib1 n )
( define ( fib-iter a b counter )
( if ( = counter 0 ) b
( fib-iter ( + a b ) a ( - counter 1 ) ) ) )
( fib-iter 1 0 n ) )
;; Counting change
( define ( count-change amount )
( cc amount 5 ) )
( cond ( ( = amount 0 ) 1 )
( ( or ( < amount 0 ) ( = kinds-of-coins 0 ) ) 0 )
( else ( + ( cc amount ( - kinds-of-coins 1 ) )
( cc ( - amount ( first-denomination kinds-of-coins ) )
kinds-of-coins ) ) ) ) )
( define ( first-denomination kinds-of-coins )
( cond ( ( = kinds-of-coins 1 ) 1 )
( ( = kinds-of-coins 2 ) 5 )
( ( = kinds-of-coins 3 ) 10 )
( ( = kinds-of-coins 4 ) 25 )
( ( = kinds-of-coins 5 ) 50 ) ) )
;; Exponentiation
( define ( my-expt b n )
( if ( = n 0 ) 1
( * b ( my-expt b ( - n 1 ) ) ) ) )
( define ( fast-expt b n )
( cond ( ( = n 0 ) 1 )
( ( my-even? n ) ( square ( fast-expt b ( / n 2 ) ) ) )
( else ( * b ( fast-expt b ( - n 1 ) ) ) ) ) )
;; Greatest Common Divisors
( define ( my-gcd a b )
( if ( = b 0 )
a
( my-gcd b ( remainder a b ) ) ) )
;; Testing for Primality
( define ( is-prime? num )
( define ( test-div div )
( cond ( ( >= div num ) #t )
( ( = ( remainder num div ) 0 ) #f )
( else ( test-div ( + div 2 ) ) ) ) )
( cond ( ( = ( remainder num 2 ) 0 ) #f )
( else ( test-div 3 ) ) ) )
( * n n ) )
( define ( smallest-divisor n )
( find-divisor n 2 ) )
( define ( find-divisor n test-divisor )
( cond ( ( > ( square test-divisor ) n ) n )
( ( divides? test-divisor n ) test-divisor )
( else ( find-divisor n ( + test-divisor 1 ) ) ) ) )
( define ( divides? a b )
( = ( remainder b a ) 0 ) )
( define ( prime? n )
( = n ( smallest-divisor n ) ) )
;; Procedures as Arguments
( define ( cube x )
( * x x x ) )
( define ( sum term a next b )
( if ( > a b )
0
( + ( term a )
( sum term ( next a ) next b ) ) ) )
( define ( pi-sum low-limit high-limit )
( sum ( lambda ( x ) ( / 1.0 ( * x ( + x 2 ) ) ) )
low-limit
( lambda ( x ) ( + x 4 ) )
high-limit ) )
( define ( sum term low-limit next high-limit )
( if ( > low-limit high-limit )
0
( + ( term low-limit )
( sum term ( next low-limit ) next high-limit ) ) ) )
( define ( integral func low-limit high-limit dx )
( * ( sum func
( + low-limit ( / dx 2.0 ) )
( lambda ( x ) ( + x dx ) )
high-limit )
dx ) )
;;Constructing Procedures Using Lambda
( ( lambda ( x )
( + ( let ( ( x 3 ) )
( + x ( * x 10 ) ) )
x ) ) 5 )
( ( lambda ( x y )
( let ( ( x 3 )
( y ( + x 2 ) ) )
( * x y ) ) ) 2 10 )
;; f( x, y ) = x( 1 + xy ) ^ 2 + y( 1 - y ) + ( 1 + xy )( 1 - y s)
;; a = 1 + xy
;; b = 1 - y
;; f( x, y ) = x * a ^ 2 + y * b + a * b
( define ( func x y )
( let ( ( a ( + 1 ( * x y ) ) )
( b ( - 1 y ) ) )
( + ( * x ( square a ) )
( * y b )
( * a b ) ) ) )
;; Finding roots if equations by the half-interval method
( define ( average a b )
( / ( + a b ) 2.0 ) )
( define ( close-enough? x y )
( < ( abs ( - x y ) ) 0.001 ) )
( define ( search func neg-point pos-point )
( let ( ( mid-point ( average neg-point pos-point ) ) )
( if ( close-enough? neg-point pos-point )
mid-point
( let ( ( test-value ( func mid-point ) ) )
( cond ( ( positive? test-value )
( search func neg-point mid-point ) )
( ( negative? test-value )
( search func mid-point pos-point ) )
( else mid-point ) ) ) ) ) )
( define ( half-interval-method func a b )
( let ( ( a-value ( func a ) )
( b-value ( func b ) ) )
( cond ( ( and ( negative? a-value )
( positive? b-value ) )
( search func a b ) )
( ( and ( negative? b-value )
( positive? a-value ) )
( search func b a ) )
( else
( error "Values are not of opposite sign." ) ) ) ) )
( half-interval-method
( lambda ( x )
( - ( * x x x ) ( * 2 x ) 3 ) )
1.0
2.0 )
;; The Fermat test:
( define ( bad-exp base exp )
( cond ( ( = exp 0 ) 1 )
( ( even? exp )
( square ( bad-exp base ( / exp 2 ) ) ) )
( else ( * base ( bad-exp base ( - exp 1 ) ) ) ) ) )
( define ( bad-expmod base exp m )
( remainder ( bad-exp base exp ) m ) )
( define ( expmod base exp m )
( cond ( ( = exp 0 ) 1 )
( ( even? exp )
( remainder
( square ( expmod base ( / exp 2 ) m ) )
m ) )
( else
( remainder
( * base ( expmod base ( - exp 1 ) m ) )
m ) ) ) )
;; ( expmod 32 10911110033 10911110033 )
;; ( my-expmod 32 1091111003 1091111003 )
( define ( fermat-test n )
( define ( try-it a )
( = ( expmod a n n ) a ) )
( try-it ( + 1 ( random ( - n 1 ) ) ) ) )
( define ( fast-prime? n times )
( cond ( ( = times 0 ) true )
( ( fermat-test n )
( fast-prime? n ( - times 1 ) ) )
( else false ) ) )
;; Finding fixed points of functions
( define tolerance 0.00001 )
( define ( good-enough? v1 v2 )
( < ( abs ( - v1 v2 ) ) tolerance ) )
( define ( fixed-point func now-guess )
( let ( ( next-guess ( func now-guess ) ) )
( cond ( ( good-enough? now-guess next-guess ) now-guess )
( else ( fixed-point func next-guess ) ) ) ) )
( fixed-point cos 1.0 )
;; The result in an infinite loop in which
;; the two guesses y1 and y2 repeat over and over
;; oscillating about the answer
;; one way to control such oscillations is to
;; prevent the guesses from changing so much.
;; Since the answer is always between our guess y and x/y
;; we can make a new guess that is not as far from y as x/y
;; by average y with x/y
;; so that the next guess after y is ( y + x/y )/2 instead od x/y
;; The process of making such a sequence of guesses is simply the
;; process of looking for a fixed point of y |-> ( y + x/y )/2
( define ( my-sqrt x )
( fixed-point ( lambda ( y )
( average y ( / x y ) ) ) 1.0 ) )
( my-sqrt 4 )
;; Procedures as Returned Values
( define ( average-damp func )
( lambda ( x )
( average x ( func x ) ) ) )
( ( average-damp square ) 10 )
( define ( my-sqrt x )
( fixed-point ( average-damp ( lambda ( y )
( / x y ) ) ) 1.0 ) )
;; Newton‘s method
;; taking dx to be, say 0.00001
( define ( deriv func )
( lambda( x )
( / ( - ( func ( + x dx ) ) ( func x ) ) dx ) ) )
( define ( cube x )
( * x x x ) )
( ( deriv cube ) 5 )
( define ( newton-transform func )
( lambda ( x )
( - x ( / ( func x ) ( ( deriv func ) x ) ) ) ) )
( define ( newton-method func guess )
( fixed-point ( newton-transform func ) guess ) )
( define ( my-sqrt x )
( newton-method ( lambda ( y )
( - ( square y ) x ) ) 1.0 ) )
( define ( my-sqrt x )
( define ( good-enough? guess )
( < ( abs ( - ( square guess ) x ) ) 0.001 ) )
( define ( improve guess )
( average guess ( / x guess ) ) )
( define ( sqrt-iter guess )
( if ( good-enough? guess )
guess
( sqrt-iter ( improve guess ) ) ) )
( sqrt-iter 1.0 ) )
;; fac
( define ( fac n )
( if ( = n 1 ) 1
( * n ( fac ( - n 1 ) ) ) ) )
( define ( fac1 n )
( define ( fac-iter product counter )
( if ( > counter n ) product
( fac-iter ( * counter product )
( + counter 1 ) ) ) )
( fac-iter 1 1 ) )
;; Ackerman
( define ( Ackerman x y )
( cond ( ( = y 0 ) 0 )
( ( = x 0 ) ( * 2 y ) )
( ( = y 1 ) 2 )
( else ( Ackerman ( - x 1 )
( Ackerman x ( - y 1 ) ) ) ) ) )
;; Fibonacci
( define ( fib n )
( cond ( ( = n 0 ) 0 )
( ( = n 1 ) 1 )
( else ( + ( fib ( - n 1 ) )
( fib ( - n 2 ) ) ) ) ) )
( define ( fib1 n )
( define ( fib-iter a b counter )
( if ( = counter 0 ) b
( fib-iter ( + a b ) a ( - counter 1 ) ) ) )
( fib-iter 1 0 n ) )
;; Counting change
( define ( count-change amount )
( cc amount 5 ) )
( cond ( ( = amount 0 ) 1 )
( ( or ( < amount 0 ) ( = kinds-of-coins 0 ) ) 0 )
( else ( + ( cc amount ( - kinds-of-coins 1 ) )
( cc ( - amount ( first-denomination kinds-of-coins ) )
kinds-of-coins ) ) ) ) )
( define ( first-denomination kinds-of-coins )
( cond ( ( = kinds-of-coins 1 ) 1 )
( ( = kinds-of-coins 2 ) 5 )
( ( = kinds-of-coins 3 ) 10 )
( ( = kinds-of-coins 4 ) 25 )
( ( = kinds-of-coins 5 ) 50 ) ) )
;; Exponentiation
( define ( my-expt b n )
( if ( = n 0 ) 1
( * b ( my-expt b ( - n 1 ) ) ) ) )
( define ( my-even? n )
( = ( remainder n 2 ) 0 ) )
( define ( fast-expt b n )
( cond ( ( = n 0 ) 1 )
( ( my-even? n ) ( square ( fast-expt b ( / n 2 ) ) ) )
( else ( * b ( fast-expt b ( - n 1 ) ) ) ) ) )
;; Greatest Common Divisors
( define ( my-gcd a b )
( if ( = b 0 )
a
( my-gcd b ( remainder a b ) ) ) )
;; Testing for Primality
( define ( is-prime? num )
( define ( test-div div )
( cond ( ( >= div num ) #t )
( ( = ( remainder num div ) 0 ) #f )
( else ( test-div ( + div 2 ) ) ) ) )
( cond ( ( = ( remainder num 2 ) 0 ) #f )
( else ( test-div 3 ) ) ) )
;; Searching for divisors
( define ( square n )( * n n ) )
( define ( smallest-divisor n )
( find-divisor n 2 ) )
( define ( find-divisor n test-divisor )
( cond ( ( > ( square test-divisor ) n ) n )
( ( divides? test-divisor n ) test-divisor )
( else ( find-divisor n ( + test-divisor 1 ) ) ) ) )
( define ( divides? a b )
( = ( remainder b a ) 0 ) )
( define ( prime? n )
( = n ( smallest-divisor n ) ) )
;; Procedures as Arguments
( define ( cube x )
( * x x x ) )
( define ( sum term a next b )
( if ( > a b )
0
( + ( term a )
( sum term ( next a ) next b ) ) ) )
( define ( pi-sum low-limit high-limit )
( sum ( lambda ( x ) ( / 1.0 ( * x ( + x 2 ) ) ) )
low-limit
( lambda ( x ) ( + x 4 ) )
high-limit ) )
( define ( sum term low-limit next high-limit )
( if ( > low-limit high-limit )
0
( + ( term low-limit )
( sum term ( next low-limit ) next high-limit ) ) ) )
( define ( integral func low-limit high-limit dx )
( * ( sum func
( + low-limit ( / dx 2.0 ) )
( lambda ( x ) ( + x dx ) )
high-limit )
dx ) )
;;Constructing Procedures Using Lambda
( ( lambda ( x )
( + ( let ( ( x 3 ) )
( + x ( * x 10 ) ) )
x ) ) 5 )
( ( lambda ( x y )
( let ( ( x 3 )
( y ( + x 2 ) ) )
( * x y ) ) ) 2 10 )
;; f( x, y ) = x( 1 + xy ) ^ 2 + y( 1 - y ) + ( 1 + xy )( 1 - y s)
;; a = 1 + xy
;; b = 1 - y
;; f( x, y ) = x * a ^ 2 + y * b + a * b
( define ( func x y )
( let ( ( a ( + 1 ( * x y ) ) )
( b ( - 1 y ) ) )
( + ( * x ( square a ) )
( * y b )
( * a b ) ) ) )
;; Finding roots if equations by the half-interval method
( define ( average a b )
( / ( + a b ) 2.0 ) )
( define ( close-enough? x y )
( < ( abs ( - x y ) ) 0.001 ) )
( define ( search func neg-point pos-point )
( let ( ( mid-point ( average neg-point pos-point ) ) )
( if ( close-enough? neg-point pos-point )
mid-point
( let ( ( test-value ( func mid-point ) ) )
( cond ( ( positive? test-value )
( search func neg-point mid-point ) )
( ( negative? test-value )
( search func mid-point pos-point ) )
( else mid-point ) ) ) ) ) )
( define ( half-interval-method func a b )
( let ( ( a-value ( func a ) )
( b-value ( func b ) ) )
( cond ( ( and ( negative? a-value )
( positive? b-value ) )
( search func a b ) )
( ( and ( negative? b-value )
( positive? a-value ) )
( search func b a ) )
( else
( error "Values are not of opposite sign." ) ) ) ) )
( half-interval-method
( lambda ( x )
( - ( * x x x ) ( * 2 x ) 3 ) )
1.0
2.0 )
;; The Fermat test:
( define ( bad-exp base exp )
( cond ( ( = exp 0 ) 1 )
( ( even? exp )
( square ( bad-exp base ( / exp 2 ) ) ) )
( else ( * base ( bad-exp base ( - exp 1 ) ) ) ) ) )
( define ( bad-expmod base exp m )
( remainder ( bad-exp base exp ) m ) )
( define ( expmod base exp m )
( cond ( ( = exp 0 ) 1 )
( ( even? exp )
( remainder
( square ( expmod base ( / exp 2 ) m ) )
m ) )
( else
( remainder
( * base ( expmod base ( - exp 1 ) m ) )
m ) ) ) )
;; ( expmod 32 10911110033 10911110033 )
;; ( my-expmod 32 1091111003 1091111003 )
( define ( fermat-test n )
( define ( try-it a )
( = ( expmod a n n ) a ) )
( try-it ( + 1 ( random ( - n 1 ) ) ) ) )
( define ( fast-prime? n times )
( cond ( ( = times 0 ) true )
( ( fermat-test n )
( fast-prime? n ( - times 1 ) ) )
( else false ) ) )
;; Finding fixed points of functions
( define tolerance 0.00001 )
( define ( good-enough? v1 v2 )
( < ( abs ( - v1 v2 ) ) tolerance ) )
( define ( fixed-point func now-guess )
( let ( ( next-guess ( func now-guess ) ) )
( cond ( ( good-enough? now-guess next-guess ) now-guess )
( else ( fixed-point func next-guess ) ) ) ) )
( fixed-point cos 1.0 )
( fixed-point ( lambda ( x )
( + ( sin x ) ( cos x ) ) ) 1.0 );; The result in an infinite loop in which
;; the two guesses y1 and y2 repeat over and over
;; oscillating about the answer
;; one way to control such oscillations is to
;; prevent the guesses from changing so much.
;; Since the answer is always between our guess y and x/y
;; we can make a new guess that is not as far from y as x/y
;; by average y with x/y
;; so that the next guess after y is ( y + x/y )/2 instead od x/y
;; The process of making such a sequence of guesses is simply the
;; process of looking for a fixed point of y |-> ( y + x/y )/2
( define ( my-sqrt x )
( fixed-point ( lambda ( y )
( average y ( / x y ) ) ) 1.0 ) )
( my-sqrt 4 )
;; Procedures as Returned Values
( define ( average-damp func )
( lambda ( x )
( average x ( func x ) ) ) )
( ( average-damp square ) 10 )
( define ( my-sqrt x )
( fixed-point ( average-damp ( lambda ( y )
( / x y ) ) ) 1.0 ) )
( my-sqrt 4 )
;; Newton‘s method
;; taking dx to be, say 0.00001
( define dx 0.00001 )
( define ( deriv func )
( lambda( x )
( / ( - ( func ( + x dx ) ) ( func x ) ) dx ) ) )
( define ( cube x )
( * x x x ) )
( ( deriv cube ) 5 )
( define ( newton-transform func )
( lambda ( x )
( - x ( / ( func x ) ( ( deriv func ) x ) ) ) ) )
( define ( newton-method func guess )
( fixed-point ( newton-transform func ) guess ) )
( define ( my-sqrt x )
( newton-method ( lambda ( y )
( - ( square y ) x ) ) 1.0 ) )
声明：以上内容来自用户投稿及互联网公开渠道收集整理发布，本网站不拥有所有权，未作人工编辑处理，也不承担相关法律责任，若内容有误或涉及侵权可进行投诉： 投诉/举报 工作人员会在5个工作日内联系你，一经查实，本站将立刻删除涉嫌侵权内容。