SICP -- 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 ) ) ) ) )

( = ( 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 ) ) ) )

( * 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 ) )