(* SICP Chapter #01 Examples in F# *) #light (* 1.1.1 The Elements of Programming - Expressions *) 486 137 + 349 1000 - 334 5 * 99 10 / 5 2.7 + 10.0 21 + 35 + 12 + 7 25 * 4 * 12 3 * 5 + 10 - 6 3 * (2 * 4 + 3 + 5) + 10 - 7 + 6 (* 1.1.2 The Elements of Programming - Naming and the Environment *) let size = 2 size 5 * size let pi = 3.14159 let radius = 10.0 pi * radius * radius let circumference = 2.0 * pi * radius circumference (* 1.1.3 The Elements of Programming - Evaluating Combinations *) (2 + 4 * 6) * (3 + 5 + 7) (* 1.1.4 The Elements of Programming - Compound Procedures *) let square x = x * x square 21 square(2 + 5) square(square 3) let sum_of_squares x y = square x + square y sum_of_squares 3 4 let f a = sum_of_squares (a + 1) (a * 2) f 5 (* 1.1.5 The Elements of Programming - The Substitution Model for Procedure Application *) f 5 sum_of_squares (5 + 1) (5 * 2) square 6 + square 10 6 * 6 + 10 * 10 36 + 100 f 5 sum_of_squares (5 + 1) (5 * 2) square(5 + 1) + square(5 * 2) ((5 + 1) * (5 + 1)) + ((5 * 2) * (5 * 2)) (6 * 6) + (10 * 10) 36 + 100 136 (* 1.1.6 The Elements of Programming - Conditional Expressions and Predicates *) let abs x = if x > 0 then x else if x = 0 then 0 else -x let abs' x = if x < 0 then -x else x let x = 6 x > 5 && x < 10 let ge x y = x > y || x = y let ge' x y = not(x < y) (* Exercise 1.1 *) 10 5 + 3 + 4 9 - 1 6 / 2 2 * 4 + 4 - 6 let a = 3 let b = a + 1 a + b + a * b a = b if b > a && b < a * b then b else a if a = 4 then 6 else if b = 4 then 6 + 7 + a else 25 2 + if b > a then b else a (if a > b then a else if a < b then b else -1) * (a + 1) (* Exercise 1.2 *) (5. + 4. + (2. - (3. - (6. + 4. / 5.)))) / (3. * (6. - 2.) * (2. - 7.)) (* Exercise 1.3 *) let three_n n1 n2 n3 = if n1 > n2 then if n1 > n3 then if n2 > n3 then n1*n1 + n2*n2 else n1*n1 + n3*n3 else n1*n1 + n3*n3 else if n2 > n3 then if n1 > n3 then n2*n2 + n1*n1 else n2*n2 + n3*n3 else n2*n2 + n3*n3 (* Exercise 1.4 *) let a_plus_abs_b a b = if b > 0 then a + b else a - b (* Exercise 1.5 *) let rec p () = p() let test x y = if x = 0 then 0 else y (* commented out as this is in infinite loop test 0 p() *) (* 1.1.7 The Elements of Programming - Example: Square Roots by Newton's Method *) let abs_float x = if (x < 0.0) then - x else x let square_float x = x * x let good_enough guess x = abs_float(square_float guess - x) < 0.001 let average x y = (x + y) / 2.0 let improve guess x = average guess (x / guess) let rec sqrt_iter guess x = if good_enough guess x then guess else sqrt_iter (improve guess x) x let sqrt x = sqrt_iter 1.0 x sqrt 9.0 sqrt(100.0 + 37.0) sqrt(sqrt 2.0 + sqrt 3.0) square_float(sqrt 1000.0) (* Exercise 1.6 *) let new_if predicate then_clause else_clause = if predicate then then_clause else else_clause new_if (2=3) 0 5 new_if (1=1) 0 5 let rec sqrt_iter' guess x = new_if (good_enough guess x) guess (sqrt_iter' (improve guess x) x) (* from wadler paper *) let newif p x y = match p with | true -> x | false -> y (* Exercse 1.7 *) let good_enough_gp guess prev = abs_float(guess - prev) / guess < 0.001 let rec sqrt_iter_gp guess prev x = if good_enough_gp guess prev then guess else sqrt_iter_gp (improve guess x) guess x let sqrt_gp x = sqrt_iter_gp 4.0 1.0 x (* Exercise 1.8 *) let improve_cube guess x = (2.0 * guess + x / (guess * guess)) / 3.0 let rec cube_iter guess prev x = if good_enough_gp guess prev then guess else cube_iter (improve_cube guess x) guess x let cube_root' x = cube_iter 27.0 1.0 x (* 1.1.8 The Elements of Programming - Procedures as Black-Box Abstractions *) let square_float' x = x * x let double x = x + x let square_float'' x = exp(double(log x)) let good_enough_1 guess x = abs_float(square_float guess - x) < 0.001 let improve_1 guess x = average guess (x / guess) let rec sqrt_iter_1 guess x = if good_enough_1 guess x then guess else sqrt_iter_1 (improve_1 guess x) x let sqrt_1 x = sqrt_iter_1 1.0 x square_float 5.0 (* Block-structured *) let sqrt_2 x = let good_enough guess x = abs_float(square_float guess - x) < 0.001 and improve guess x = average guess (x / guess) in let rec sqrt_iter guess x = if good_enough guess x then guess else sqrt_iter (improve guess x) x in sqrt_iter 1.0 x (* Taking advantage of lexical scoping *) let sqrt_3 x = let good_enough guess = abs_float(square_float guess - x) < 0.001 and improve guess = average guess (x / guess) in let rec sqrt_iter guess = if good_enough guess then guess else sqrt_iter (improve guess) in sqrt_iter 1.0 (* 1.2.1 Procedures and the Processes They Generate - Linear Recursion and Iteration *) (* Recursive *) let rec factorial n = if n = 1 then 1 else n * factorial(n - 1) factorial 6 (* Iterative *) let rec fact_iter product counter max_count = if counter > max_count then product else fact_iter (counter * product) (counter + 1) max_count let factorial' n = fact_iter 1 1 n (* Iterative, block-structured (from footnote) *) let factorial'' n = let rec iter product counter = if counter > n then product else iter (counter * product) (counter + 1) in iter 1 1 (* Exercise 1.9 *) let inc a = a + 1 let dec a = a - 1 let rec plus a b = if a = 0 then b else inc(plus (dec a) b) let rec plus' a b = if a = 0 then b else plus' (dec a) (inc b) (* Exercise 1.10 *) let rec a' x y = match x, y with | x, 0 -> 0 | 0, y -> 2 * y | x, 1 -> 2 | x, y -> (a' (x - 1) (a' x (y - 1))) a' 1 10 a' 2 4 a' 3 3 let f' n = a' 0 n let g' n = a' 1 n let h' n = a' 2 n let k' n = 5 * n * n (* 1.2.2 Procedures and the Processes They Generate - Tree Recursion *) (* Recursive *) let rec fib n = match n with | 0 -> 0 | 1 -> 1 | n -> fib(n - 1) + fib(n - 2) (* Iterative *) let rec fib_iter a b count = match count with | 0 -> b | count -> fib_iter (a + b) a (count - 1) let fib' n = fib_iter 1 0 n (* Counting change *) let first_denomination x = match x with | 1 -> 1 | 2 -> 5 | 3 -> 10 | 4 -> 25 | 5 -> 50 | x -> raise Not_found let rec cc amount kinds_of_coins = if amount = 0 then 1 else if amount < 0 then 0 else if kinds_of_coins = 0 then 0 else (cc amount (kinds_of_coins - 1)) + (cc (amount - (first_denomination kinds_of_coins)) kinds_of_coins) let count_change amount = cc amount 5 count_change 100 (* Exercise 1.11 *) let rec fb n = if n < 3 then n else fb(n-1) + 2*fb(n-2) + 3*fb(n-3) let rec f_iter a b c count = match count with | 0 -> c | _ -> f_iter (a + 2*b + 3*c) a b (count-1) let fc n = f_iter 2 1 0 n (* Exercise 1.12 *) let rec pascals_triangle n k = match n, k with | 0, k -> 1 | n, 0 -> 1 | n, k -> if n = k then 1 else (pascals_triangle (n-1) (k-1)) + (pascals_triangle (n-1) k) (* 1.2.3 Procedures and the Processes They Generate - Orders of Growth *) (* Exercise 1.15 *) let cube x = x * x * x let p' x = (3.0 * x) - (4.0 * cube x) let rec sine angle = if not(abs_float angle > 0.1) then angle else p'(sine(angle / 3.0)) (* 1.2.4 Procedures and the Processes They Generate - Exponentiation *) (* Linear recursion *) let rec expt b n = match n with | 0 -> 1 | n -> b * (expt b (n - 1)) (* Linear iteration *) let rec expt_iter b counter product = match counter with | 0 -> product | counter -> expt_iter b (counter - 1) (b * product) let expt' b n = expt_iter b n 1 (* Logarithmic iteration *) let even n = ((n % 2) = 0) let rec fast_expt b n = match n with | 0 -> 1 | n -> if even n then square(fast_expt b (n / 2)) else b * (fast_expt b (n - 1)) (* Exercise 1.17 *) let multiply a b = match b with | 0 -> 0 | b -> a + a*(b - 1) (* Exercise 1.19 *) let rec fib_iter'' a b p q count = match count with | 0 -> b | count -> if even count then fib_iter'' a b (p*p + q*q) (2*p*q + q*q) (count / 2) else fib_iter'' (b*q + a*q + a*p) (b*p + a*q) p q (count - 1) let fib'' n = fib_iter'' 1 0 0 1 n (* 1.2.5 Procedures and the Processes They Generate - Greatest Common Divisors *) let rec gcd a b = match b with | 0 -> a | b -> gcd b (a % b) gcd 40 6 (* Exercise 1.20 *) gcd 206 40 (* 1.2.6 Procedures and the Processes They Generate - Example: Testing for Primality *) (* prime *) let divides a b = (b % a = 0) let rec find_divisor n test_divisor = if square test_divisor > n then n else if divides test_divisor n then test_divisor else find_divisor n (test_divisor + 1) let smallest_divisor n = find_divisor n 2 let prime n = (n = smallest_divisor n) (* fast_prime *) let rec expmod nbase nexp m = match nexp with | 0 -> 1 | nexp -> if even nexp then square(expmod nbase (nexp / 2) m) % m else (nbase * (expmod nbase (nexp - 1) m)) % m let rand = new System.Random() let fermat_test n = let try_it a = ((expmod a n n) = a) in try_it(1 + rand.Next(n - 1)) let rec fast_prime n ntimes = match ntimes with | 0 -> true | ntimes -> if fermat_test n then fast_prime n (ntimes - 1) else false (* Exercise 1.21 *) smallest_divisor 199 smallest_divisor 1999 smallest_divisor 19999 (* Exercise 1.22 *) let report_prime elapsed_time = print_string (" *** " ^ (string_of_float elapsed_time)) let start_prime_test n start_time = if (prime n) then report_prime(Sys.time() - start_time) else () let timed_prime_test n = let x = print_string ("\n" ^ (string_of_int n)) in start_prime_test n (Sys.time()) (* Exercise 1.25 *) let expmod' nbase nexp m = (fast_expt nbase nexp) % m (* Exercise 1.26 *) let rec expmod'' nbase nexp m = match nexp with | 0 -> 1 | nexp -> if (even nexp) then ((expmod'' nbase (nexp / 2) m) * (expmod'' nbase (nexp / 2) m)) % m else (nbase * (expmod'' nbase (nexp - 1) m)) % m (* Exercise 1.27 *) let carmichael n = (fast_prime n 100) && not(prime n) carmichael 561 carmichael 1105 carmichael 1729 carmichael 2465 carmichael 2821 carmichael 6601 (* 1.3 Formulating Abstractions with Higher-Order Procedures *) let cube' x = x * x * x (* 1.3.1 Formulating Abstractions with Higher-Order Procedures - Procedures as Arguments *) let rec sum_integers a b = if a > b then 0 else a + (sum_integers (a + 1) b) let rec sum_cubes a b = if a > b then 0 else cube' a + (sum_cubes (a + 1) b) let rec pi_sum a b = if a > b then 0.0 else (1.0 / (a * (a + 2.0))) + (pi_sum (a + 4.0) b) let rec sum term a next b = if a > b then 0 else term a + (sum term (next a) next b) (* Using sum *) let inc' n = n + 1 let sum_cubes' a b = sum cube' a inc b sum_cubes' 1 10 let identity x = x let sum_integers' a b = sum identity a inc b sum_integers' 1 10 let rec sum_float term a next b = if a > b then 0.0 else term a + (sum_float term (next a) next b) let pi_sum' a b = let pi_term x = 1.0 / (x * (x + 2.0)) and pi_next x = x + 4.0 in sum_float pi_term a pi_next b 8.0 * (pi_sum' 1.0 1000.0) let integral f a b dx = let add_dx x = x + dx in (sum_float f (a + (dx / 2.0)) add_dx b) * dx let cube_float x = x * x * x integral cube_float 0.0 1.0 0.01 integral cube_float 0.0 1.0 0.001 (* Exercise 1.29 *) let simpson f a b n = let h = abs_float(b - a) / (float_of_int n) in let rec sum_iter term start next stop acc = if start > stop then acc else sum_iter term (next start) next stop (acc + (term (a + (float_of_int start) * h))) in h * (sum_iter f 1 inc n 0.0) simpson cube_float 0.0 1.0 100 (* Exercise 1.30 *) let rec sum_iter term a next b acc = if a > b then acc else sum_iter term (next a) next b (acc + term a) let sum_cubes'' a b = sum_iter cube' a inc b 0 sum_cubes'' 1 10 (* Exercise 1.31 *) let rec product term a next b = if a > b then 1 else term a * (product term (next a) next b) let factorial''' n = product identity 1 inc n let rec product_iter term a next b acc = if a > b then acc else product_iter term (next a) next b (acc * term a) (* Exercise 1.32 *) let rec accumulate combiner null_value term a next b = if a > b then null_value else combiner (term a) (accumulate combiner null_value term (next a) next b) let sum' a b = accumulate ( + ) 0 identity a inc b let product' a b = accumulate ( * ) 1 identity a inc b let rec accumulate_iter combiner term a next b acc = if a > b then acc else accumulate_iter combiner term (next a) next b (combiner acc (term a)) let sum'' a b = accumulate_iter ( + ) identity a inc b 0 let product'' a b = accumulate_iter ( * ) identity a inc b 1 (* Exercise 1.33 *) let rec filtered_accumulate combiner null_value term a next b pred = if a > b then null_value else if pred a then combiner (term a) (filtered_accumulate combiner null_value term (next a) next b pred) else filtered_accumulate combiner null_value term (next a) next b pred filtered_accumulate ( +) 0 square 1 inc 5 prime (* 1.3.2 Formulating Abstractions with Higher-Order Procedures - Constructing Procedures Using Lambda *) let pi_sum'' a b = sum_float (fun x -> 1.0 / (x * (x + 2.0))) a (fun x -> x + 4.0) b let integral' f a b dx = (sum_float f (a + (dx / 2.0)) (fun x -> x + dx) b) * dx let plus4 x = x + 4 let plus4' = fun x -> x + 4 (fun x y z -> x + y + (square z)) 1 2 3 (* Using let *) let fd x y = let f_helper a b = (x * (square a)) + (y * b) + (a * b) in f_helper (1 + (x * y)) (1 - y) let fe x y = (fun a b -> (x * square a) + (y * b) + (a * b)) (1 + x*y) (1 - y) let ff x y = let a = 1 + x*y and b = 1 - y in (x * square a) + y*b + a*b let xa = 5 (let xa = 3 in xa + (xa * 10)) + x let xb = 2 in let xb = 3 and y = xb + 2 in xb * y;; let fg x y = let a = 1 + x*y and b = 1 - y in x*square a + y*b + a*b (* Exercise 1.34 *) let fh g = g 2 fh square fh(fun z -> z * (z + 1)) (* 1.3.3 Formulating Abstractions with Higher-Order Procedures - Procedures as General Methods *) (* Half-interval method *) let close_enough x y = (abs_float(x - y) < 0.001) let positive x = (x >= 0.0) let negative x = not(positive x) let rec search f neg_point pos_point = let midpoint = average neg_point pos_point in if close_enough neg_point pos_point then midpoint else let test_value = f midpoint in if positive test_value then search f neg_point midpoint else if negative test_value then search f midpoint pos_point else midpoint exception Invalid of string let half_interval_method f a b = let a_value = f a and b_value = f b in if negative a_value && positive b_value then (search f a b) else if negative b_value && positive a_value then (search f b a) else raise (Invalid("Values are not of opposite sign" ^ string_of_float a ^ " " ^ string_of_float b)) half_interval_method sin 2.0 4.0 half_interval_method (fun x -> (x * x * x) - (2.0 * x) - 3.0) 1.0 2.0 (* Fixed points *) let tolerance = 0.00001 let fixed_point f first_guess = let close_enough v1 v2 = abs_float(v1 - v2) < tolerance in let rec tryme guess = let next = f guess in if close_enough guess next then next else tryme next in tryme first_guess fixed_point cos 1.0 fixed_point (fun y -> sin y + cos y) 1.0 (* note: this function does not converge *) let sqrt_4 x = fixed_point (fun y -> x / y) 1.0 let sqrt_5 x = fixed_point (fun y -> (average y (x / y))) 1.0 (* Exercise 1.35 *) let goldenRatio () = fixed_point (fun x -> 1.0 + 1.0 / x) 1.0 (* Exercise 1.36 *) (* 35 guesses before convergence *) fixed_point (fun x -> log 1000.0 / log x) 1.5 (* 11 guesses before convergence (AverageDamp defined below) *) (* fixed_point (average_damp (fun x -> log 1000.0 / log x)) 1.5 *) (* Exercise 1.37 *) (* exercise left to reader to define cont_frac cont_frac (fun i -> 1.0) (fun i -> 1.0) k *) (* 1.3.4 Formulating Abstractions with Higher-Order Procedures - Procedures as Returned Values *) let average_damp f x = average x (f x) average_damp square_float 10. let sqrt_6 x = fixed_point (average_damp (( / ) x)) 1. let cube_root x = fixed_point (average_damp (fun y -> x / square_float y)) 1. (* Newton's method *) let dx = 0.00001 let deriv g x = (g(x + dx) - g x) / dx let cube'' x = x * x * x (deriv cube) 5. let newton_transform g x = x - g x / deriv g x let newtons_method g guess = fixed_point (newton_transform g) guess let sqrt_7 x = newtons_method (fun y -> (square_float y) - x) 1. (* Fixed point of transformed function *) let fixed_point_of_transform g transform guess = fixed_point (transform g) guess let sqrt_8 x = fixed_point_of_transform (( / ) x) average_damp 1. let sqrt_9 x = fixed_point_of_transform(fun y -> square_float y - x) newton_transform 1. (* Exercise 1.40 *) let cubic a b c = fun x -> cube x + (a * x * x) + (b * x) + c newtons_method (cubic 5.0 3.0 2.5) 1.0 (* Exercise 1.41 *) let double_ f = fun x -> f(f x) (double_ inc)(5) ((double_ double_) inc)(5) ((double_ (double_ double_)) inc)(5) (* Exercise 1.42 *) let compose f g = fun x -> f(g x) (compose square inc) 6 (* Exercise 1.43 *) let repeated f n = let rec iterate arg i = if i > n then arg else iterate (f arg) (i+1) in fun x -> iterate x 1 (repeated square 2) 5 (* Exercise 1.44 *) let smooth f dx = fun x -> average x ((f(x - dx) + f(x) + f(x + dx)) / 3.0) fixed_point (smooth (fun x -> log 1000.0 / log x) 0.05) 1.5 (* Exercise 1.46 *) let iterative_improve good_enough improve = let rec iterate guess = let next = improve guess in if good_enough guess next then next else iterate next in fun x -> iterate x let fixed_point' f first_guess = let tolerance = 0.00001 and good_enough v1 v2 = abs_float(v1 - v2) < tolerance in (iterative_improve good_enough f) first_guess fixed_point' (average_damp (fun x -> log 1000.0 / log x)) 1.5 |