SICP Chapter #03 Examples in Cat
// Note: Some of the examples require a stack size larger than 100 that is
// allocated in Cat by default. I increased the stack size by modifying
// the CatExceutor.cs. Likely needs much less the 10,000 that I settled on.
// const int MAX_STACK = 10000;
// "sicp01.cat" #load
#clr
/* 1.1.1 The Elements of Programming - Expressions */
486 writeln // print (486)
137 349 + writeln // print (137 + 349)
1000 334 - writeln // print (1000 - 334)
5 99 * writeln // print (5 * 99)
10 5 / writeln // print (10 / 5)
2.7 10.0 + writeln // print (2.7 + 10.0)
21 35 + 12 + 7 + writeln // print (21 + 35 + 12 + 7)
25 4 * 12 * writeln // print (25 * 4 * 12)
3 5 * 10 + 6 - writeln // print (3 * 5 + 10 - 6)
3 2 4 * 3 + 5 + * 10 7 - 6 + + writeln // print (3 * (2 * 4 + 3 + 5) + 10 - 7 + 6)
/* 1.1.2 The Elements of Programming - Naming and the Environment */
define size { 2 } // var size = 2
size writeln // print (size)
5 size * writeln // print (5 * size)
define pi { 3.14159 } // var pi = 3.14159
define radius { 10.0 } // var radius = 10.0
pi radius * radius * writeln // print (pi * radius * radius)
define circumference { 2.0 pi * radius *} // var circumference = 2.0 * pi * radius
circumference writeln // print (circumference)
/* 1.1.3 The Elements of Programming - Evaluating Combinations */
2 4 6 * + 3 5 + 7 + * writeln // (2 + 4 * 6) * (3 + 5 + 7)
/* 1.1.4 The Elements of Programming - Compound Procedures */
define square(x) { x x * } // function square(x) { return x * x }
define square { dup * } // function square(x) { return x * x }
21 square writeln // print (square(21))
2 5 + square writeln // print (square(2 + 5))
3 square square writeln // print (square(square(3)))
define sum_of_squares(x y) { x square y square + } // function sum_of_squares(x, y) { return square(x) + square(y) }
define sum_of_squares { square swap square + } // function sum_of_squares(x, y) { return square(x) + square(y) }
3 4 sum_of_squares writeln // print (sum_of_squares(3, 4))
define f(a) { a 1 + a 2 * sum_of_squares } // function f(a) { return sum_of_squares(a + 1, a * 2) }
define f { dup 1 + swap 2 * sum_of_squares } // function f(a) { return sum_of_squares(a + 1, a * 2) }
5 f writeln // print (f(5))
/* 1.1.5 The Elements of Programming - The Substitution Model for Procedure Application */
5 f writeln // print (f(5))
5 1 + 5 2 * sum_of_squares writeln // print (sum_of_squares(5 + 1, 5 * 2))
6 square 10 square + writeln // print (square(6) + square(10))
6 6 * 10 10 * + writeln // print ((6 * 6) + (10 * 10))
36 100 + writeln // print (36 + 100)
5 f writeln // print (f(5))
5 1 + 5 2 * sum_of_squares writeln // print (sum_of_squares(5 + 1, 5 * 2))
5 1 + square 5 2 * square + writeln // print (square(5 + 1) + square(5 * 2))
5 1 + 5 1 + * 5 2 * 5 2 * * + writeln // print (((5 + 1) * (5 + 1)) + ((5 * 2) * (5 * 2)))
6 6 * 10 10 * + writeln // print ((6 * 6) + (10 * 10))
36 100 + writeln // print (36 + 100)
136 writeln // print (136)
/* 1.1.6 The Elements of Programming - Conditional Expressions and Predicates */
define abs_int(x) { // function abs_int(x) {
x 0 > // if (x > 0)
[x] // return x
[x 0 eq // else if (x == 0)
[0] // return 0
[x neg] // else
if] // return -x
if // }
}
define abs_int(x) { // function abs_int(x) {
x 0 < // if (x < 0)
[x neg] // return -x
[x] // else
if // return x
} // }
define abs_double(x) { // function abs_double(x) {
x 0.0 < // if (x < 0.0)
[x neg] // return -x
[x] // else
if // return x
} // }
define x { 6 } // var x = 6
x 5 > x 10 < and writeln // print (x > 5 && x < 10)
define ge(x y) { x y > x y eq or } // function ge(x, y) { return x > y || x == y }
define ge(x y) { x y < not } // function ge(x, y) { return !(x < y) }
// Exercise 1.1
10 writeln // print (10)
5 3 + 4 + writeln // print (5 + 3 + 4)
9 1 - writeln // print (9 - 1)
6 2 / writeln // print (6 / 2)
2 4 * 4 + 6 - writeln // print (2 * 4 + 4 - 6)
define a { 3 } // var a = 3
define b { a 1 + } // var b = a + 1
a b + a b * + writeln // print (a + b + a * b)
a b eq writeln // print (a == b)
b a > b a b * < and [b] [a] if writeln // print ((b > a && b < a * b) ? b : a)
a 4 eq [6] [b 4 eq [6 7 + a +] [25] if] if writeln // print ((a == 4) ? 6 : (b == 4) ? (6 + 7 + a) : 25)
2 b a > [b] [a] if + writeln // print (2 + ((b > a) ? b : a))
a b > [a] [a b < [b] [-1] if] if a 1 + * writeln // print (((a > b) ? a : (a < b) ? b : -1) * (a + 1))
// Exercise 1.2
5.0 4.0 + 2.0 3.0 6.0 4.0 5.0 / + - - + // print (((5.0 + 4.0 + (2.0 - (3.0 - (6.0 + (4.0 / 5.0))))) /
3.0 6.0 2.0 - * 2.0 7.0 - * / writeln // (3.0 * (6.0 - 2.0) * (2.0 - 7.0))))
// Exercise 1.3
define three_n(n1 n2 n3) { // function three_n(n1, n2, n3) {
n1 n2 > // if (n1 > n2)
[n1 n3 > // if (n1 > n3)
[n2 n3 > // if (n2 > n3)
[n1 n1 * n2 n2 * +] // return n1*n1 + n2*n2
[n1 n1 * n3 n3 * +] // else
if] // return n1*n1 + n3*n3
[n1 n1 * n3 n3 * +] // else
if] // return n1*n1 + n3*n3
[n2 n3 > // else
[n1 n3 > // if (n2 > n3)
[n2 n2 * n1 n1 * +] // if (n1 > n3)
[n2 n2 * n3 n3 * +] // return n2*n2 + n1*n1
if] // else
[n2 n2 * n3 n3 * +] // return n2*n2 + n3*n3
if] // else
if // return n2*n2 + n3*n3
} // }
// Exercise 1.4
define a_plus_abs_b(a b) { // function a_plus_abs_b(a, b) {
b 0 > // if (b > 0)
[a b +] // return a + b
[a b -] // else
if // return a - b
} // }
// Exercise 1.5
define p() { p } // function p() { return p() }
define test(x y) { // function test(x, y) {
x 0 eq // if (x == 0)
[0] // return 0
[y] // else
if // return y
} // }
// commented out as this is in infinite loop
// 0 p test // test(0, p())
/* 1.1.7 The Elements of Programming - Example: Square Roots by Newton's Method */
define square(x) { x x * } // function square(x) { return x * x }
define good_enough(guess x) { // function good_enough(guess, x) {
guess square x - abs_double 0.001 < // return abs_double(square(guess) - x) < 0.001
} // }
define average(x y) { // function average(x, y) {
x y + 2.0 / // return (x + y) / 2.0
} // }
define improve(guess x) { // function improve(guess, x) {
guess x as_dbl guess / average // return average(guess, parseFloat(x) / guess)
} // }
define sqrt_iter(guess x) { // function sqrt_iter(guess, x) {
guess x good_enough // if (good_enough(guess, x))
[guess] // return guess
[guess x improve x sqrt_iter] // else
if // return sqrt_iter(improve(guess, x), x)
} // }
define sqrt(x) { // function sqrt(x) {
1.0 x sqrt_iter // return sqrt_iter(1.0, x)
} // }
9.0 sqrt writeln // print (sqrt(9.0))
100.0 37.0 + sqrt writeln // print (sqrt(100 + 37))
2.0 sqrt 3.0 sqrt + sqrt writeln // print (sqrt(sqrt(2)+sqrt(3)))
1000.0 sqrt square writeln // print (square(sqrt(1000)))
// Exercise 1.6
define new_if(predicate then_clause else_clause) { // function new_if(predicate, then_clause, else_clause) {
predicate // if (predicate)
[then_clause] // return then_clause
[else_clause] // else
if // return else_clause
} // }
2 3 eq 0 5 new_if writeln // print (new_if((2==3), 0, 5))
1 1 eq 0 5 new_if writeln // print (new_if((1==1), 0, 5))
define sqrt_iter(guess x) { // function sqrt_iter(guess, x) {
guess x good_enough // return new_if(
guess // good_enough(guess, x),
guess x improve x sqrt_iter // guess,
new_if // sqrt_iter(improve(guess, x), x))
} // }
// from wadler paper
define newif(x y) { // fun newif true x y = x
true [x] [y] if // | newif false x y = y
}
// Exercse 1.7
define good_enough_gp(guess prev) { // function good_enough_gp(guess, prev) {
guess prev - abs_double guess / 0.001 < // return abs_double(guess - prev) / guess < 0.001
} // }
define sqrt_iter_gp(guess prev x) { // function sqrt_iter_gp(guess, prev, x) {
guess prev good_enough_gp // if (good_enough_gp(guess, prev))
[guess] // return guess
[guess x improve guess x sqrt_iter_gp] // else
if // return sqrt_iter_gp(improve(guess, x), guess, x)
} // }
define sqrt_gp(x) { // function sqrt_gp(x) {
4.0 1.0 x sqrt_iter_gp // return sqrt_iter_gp(4.0, 1.0, x)
} // }
// Exercise 1.8
define improve_cube(guess x) { // function improve_cube(guess, x) {
2.0 guess * x guess guess * / + 3.0 / // return (2.0*guess + x/(guess * guess)) / 3.0
} // }
define cube_iter(guess prev x) { // function cube_iter(guess, prev, x) {
guess prev good_enough_gp // if (good_enough_gp(guess, prev))
[guess] // return guess
[guess x improve_cube guess x cube_iter] // else
if // return cube_iter(improve_cube(guess, x), guess, x)
} // }
define cube_root(x) { // function cube_root(x) {
27.0 1.0 x cube_iter // return cube_iter(27.0, 1.0, x)
} // }
/* 1.1.8 The Elements of Programming - Procedures as Black-Box Abstractions */
define square(x) { x x * } // function square(x) { return x * x }
define double(x) { x x + } // function double(x) { return x + x }
define exp_dbl(x) { e x pow_dbl } // function exp_dbl(x) { return Math.pow(Math.e, x) }
define square_real(x) { x ln_dbl double exp_dbl } // function square_real(x) { return Math.exp(double(Math.log(x))) }
define good_enough(guess x) { // function good_enough(guess, x) {
guess square x - abs_double 0.001 < // return abs_double(square(guess) - x) < 0.001
} // }
define improve(guess x) { // function improve(guess, x) {
guess x as_dbl guess / average // return average(guess, parseFloat(x) / guess)
} // }
define sqrt_iter(guess x) { // function sqrt_iter(guess, x) {
guess x good_enough // if (good_enough(guess, x))
[guess] // return guess
[guess x improve x sqrt_iter] // else
if // return sqrt_iter(improve(guess, x), x)
} // }
define sqrt(x) { // function sqrt(x) {
1.0 x sqrt_iter // return sqrt_iter(1.0, x)
} // }
5.0 square writeln // print (square(5.0))
25.0 sqrt writeln // print (sqrt(25.0))
//ToBeDone: Block-structured
//ToBeDone: note: stuck on this until I figure out how to get local scope functions in cat
//ToBeDone: define sqrt(x) { // function sqrt(x) {
//ToBeDone: define good_enough(guess x) { // function good_enough(guess, x) {
//ToBeDone: guess square x - abs_dbl 0.001 < // return abs(square(guess) - x) < 0.001
//ToBeDone: } // }
//ToBeDone: define improve(guess x) { // function improve(guess, x) {
//ToBeDone: guess x guess / average // return average(guess, float(x) / guess)
//ToBeDone: } // }
//ToBeDone: define sqrt_iter(guess, x) { // function sqrt_iter(guess, x) {
//ToBeDone: guess x good_enough // if (good_enough(guess, x))
//ToBeDone: [guess] // return guess
//ToBeDone: [guess x improve x sqrt_iter] // else
//ToBeDone: if // return sqrt_iter(improve(guess, x), x)
//ToBeDone: } // }
//ToBeDone: 1.0 x sqrt_iter // return sqrt_iter(1.0, x)
//ToBeDone: } // }
//ToBeDone:
//ToBeDone: Taking advantage of lexical scoping
//ToBeDone: define sqrt(x) { // function sqrt(x) {
//ToBeDone: define good_enough(guess) { // function good_enough(guess) {
//ToBeDone: guess square x - abs_double 0.001 < // return abs(square(guess) - x) < 0.001
//ToBeDone: } // }
//ToBeDone: define improve(guess) { // function improve(guess) {
//ToBeDone: guess x as_dbl guess / average // return average(guess, parseFloat(x) / guess)
//ToBeDone: } // }
//ToBeDone: define sqrt_iter(guess) { // function sqrt_iter(guess) {
//ToBeDone: guess good_enough // if (good_enough(guess))
//ToBeDone: [guess] // return guess
//ToBeDone: [guess improve sqrt_iter] // else
//ToBeDone: if // return sqrt_iter(improve(guess))
//ToBeDone: } // }
//ToBeDone: 1.0 sqrt_iter // return sqrt_iter(1.0)
//ToBeDone: } // }
/* 1.2.1 Procedures and the Processes They Generate - Linear Recursion and Iteration */
// Recursive
define factorial(n) { // function factorial(n) {
n 1 eq // if (n == 1)
[1] // return 1
[n n 1 - factorial *] // else
if // return n * factorial(n - 1)
} // }
6 factorial writeln // print (factorial(6))
// Iterative
define fact_iter(product counter max_count) { // function fact_iter(product, counter, max_count) {
counter max_count > // if (counter > max_count)
[product] // return product
[count product * counter 1 + max_count fact_iter] // else
if // return fact_iter(counter * product, counter + 1, max_count)
} // }
define factorial(n) { // function factorial(n) {
1 1 n fact_iter // return fact_iter(1, 1, n)
} // }
//ToBeDone: Iterative, block-structured (from footnote)
//ToBeDone: note: stuck on this until I figure out how to get local scope functions in cat
//ToBeDone: define factorial(n) { // function factorial(n) {
//ToBeDone: define iter(product, counter) { // function iter(product, counter) {
//ToBeDone: counter n > // if (counter > n)
//ToBeDone: [product] // return product
//ToBeDone: [counter product * counter 1 + iter] // else
//ToBeDone: if // return iter(counter * product, counter + 1)
//ToBeDone: } // }
//ToBeDone: 1 1 iter // return iter(1, 1)
//ToBeDone: } // }
// Exercise 1.9
define inc_(a) { a 1 + } // function inc(a) { return a + 1 }
define dec_(a) { a 1 - } // function dec(a) { return a - 1 }
define plus(a b) { // function plus(a, b) {
a 0 eq // if (a == 0)
[b] // return b
[a dec_ b plus inc_] // else
if // return inc(plus(dec(a), b))
} // }
define plus(a b) { // function plus(a, b) {
a 0 eq // if (a == 0)
[b] // return b
[a dec_ b inc_ plus] // else
if // return plus(dec(a), inc(b))
} // }
// Exercise 1.10
define a(x y) { // function a(x, y) {
y 0 eq // if (y == 0)
[0] // return 0
[x 0 eq // else if (x == 0)
[2 y *] // return 2 * y
[y 1 eq // else if (y == 1)
[2] // return 2
[x 1 - x y 1 - a a] // else
if] // return a(x - 1, a(x, y - 1))
if] // }
if
}
1 10 a writeln // print (a(1, 10))
2 4 a writeln // print (a(2, 4))
3 3 a writeln // print (a(3, 3))
define f(n) { 0 n a } // function f(n) { return a(0, n) }
define g(n) { 1 n a } // function g(n) { return a(1, n) }
define h(n) { 2 n a } // function h(n) { return a(2, n) }
define k(n) { 5 n * n * } // function k(n) { return 5 * n * n }
/* 1.2.2 Procedures and the Processes They Generate - Tree Recursion */
// Recursive
define fib(n) { // function fib(n) {
n 0 eq // if (n == 0)
[0] // return 0
[n 1 eq // else if (n == 1)
[1] // return 1
[n 1 - fib n 2 - fib +] // else
if] // return fib(n - 1) + fib(n - 2)
if // }
}
// Iterative
define fib_iter(a b count) { // function fib_iter(a, b, count) {
count 0 eq // if (count == 0)
[b] // return b
[a b + a count 1 - fib_iter] // else
if // return fib_iter(a + b, a, count - 1)
} // }
define fib(n) { // function fib(n) {
1 0 n fib_iter // return fib_iter(1, 0, n)
} // }
// Counting change
define first_denomination(x) { // function first_denomination(x) {
x 1 eq // if (x == 1) return 1
[1] // else if (x == 2) return 5
[x 2 eq // else if (x == 3) return 10
[5] // else if (x == 4) return 25
[x 3 eq // else if (x == 5) return 50
[10] // }
[x 4 eq
[25]
[x 5 eq
[50]
[]
if]
if]
if]
if]
if
}
define cc(amount kinds_of_coins) { // function cc(amount, kinds_of_coins) {
amount 0 eq // if (amount == 0)
[1] // return 1
[amount 0 < // else if (amount < 0)
[0] // return 0
[kinds_of_coins 0 eq // else if (kinds_of_coins == 0)
[0] // return 0
[amount kinds_of_coins 1 - cc // else
amount kinds_of_coins first_denomination - // return cc(amount, kinds_of_coins - 1) +
kinds_of_coins cc +] // cc(amount - first_denomination(kinds_of_coins),
if] // kinds_of_coins)
if] // }
if
}
define count_change(amount) { // function count_change(amount) {
amount 5 cc // return cc(amount, 5)
} // }
// note: 100 runs out of stack space
100 count_change writeln // print (count_change(100))
// Exercise 1.11
define f(n) { // function f(n) {
n 3 < // if (n < 3)
[n] // return n
[n 1 - f 2 n 2 - f * + 3 n 3 - f * +] // else
if // return f(n - 1) + 2*f(n - 2) + 3*f(n - 3)
} // }
define f_iter(a b c count) { // function f_iter(a, b, c, count) {
count 0 eq // if (count == 0)
[c] // return c
[a 2 b * + 3 c * + a b count 1 - f_iter] // else
if // return f_iter(a + 2*b + 3*c, a, b, count - 1)
} // }
define f(n) { 2 1 0 n f_iter } // function f(n) { return f_iter(2, 1, 0, n) }
// Exercise 1.12
define pascals_triangle(n k) { // function pascals_triangle(n, k) {
n 0 eq k 0 eq n k eq or or // if (n == 0 || k == 0 || n == k)
[1] // return 1
[n 1 - k 1 - pascals_triangle n 1 - k pascals_triangle +] // else
if // return 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
define cube(x) { x x * x * } // function cube(x) { return x * x * x }
define p(x) { 3.0 x * 4.0 x cube * - } // function p(x) { return 3.0*x - 4.0*cube(x) }
define sine(angle) { // function sine(angle) {
angle abs_dbl 0.1 > not // if (!(abs(angle) > 0.1))
[angle] // return angle
[angle 3.0 / sine p] // else
if // return p(sine(angle / 3.0))
} // }
/* 1.2.4 Procedures and the Processes They Generate - Exponentiation */
// Linear recursion
define expt(b n) { // function expt(b, n) {
n 0 eq // if (n == 0)
[1] // return 1
[b b n 1 - expt *] // else
if // return b * expt(b, (n - 1))
} // }
// Linear iteration
define expt_iter(b counter product) { // function expt_iter(b, counter, product) {
counter 0 eq // if (counter == 0)
[product] // return product
[b counter 1 - b product * expt_iter] // else
if // return expt_iter(b, counter - 1, b * product)
} // }
define expt(b n) { // function expt(b, n) {
b n 1 expt_iter // return expt_iter(b, n, 1)
} // }
// Logarithmic iteration
define even(n) { n 2 mod 0 eq } // function even(n) { return (n % 2) == 0 }
define fast_expt(b n) { // function fast_expt(b, n) {
n 0 eq // if (n == 0)
[1] // return 1
[n even // else
[b n 2 / fast_expt square] // if (even(n))
[b b n 1 - fast_expt *] // return square(fast_expt(b, n / 2))
if] // else
if // return b * fast_expt(b, n - 1)
} // }
// Exercise 1.17
define multiply(a b) { // function multiply(a, b) {
b 0 eq // if (b == 0)
[0] // return 0
[a a b dec multiply plus] // else
if // return plus(a, multiply(a, dec(b)))
} // }
// Exercise 1.19
// exercise left to reader to solve for p' and q'
// define fib_iter(a b p q count) { // function fib_iter(a, b, p, q, count) {
// count 0 eq // if (count == 0)
// [b] // return b
// [count even // else
// [a b p' q' count 2 / ] // if (even(count))
// [b q * a q * + a p * + b p * + a q * + // return fib_iter(a, b, p', q', count / 2)
// p q count 1 - fib_iter] // else
// if] // return fib_iter((b * q) + (a * q) + (a * p), (b * p) + (a * q),
// if // p, q, count - 1)
// } // }
// define fib(n) { // function fib(n) {
// 1 0 0 1 n fib_iter // return fib_iter(1, 0, 0, 1, n)
// } // }
/* 1.2.5 Procedures and the Processes They Generate - Greatest Common Divisors */
define gcd(a b) { // function gcd(a, b) {
b 0 eq // if (b == 0)
[a] // return a
[b a b mod gcd] // else
if // return gcd(b, a % b)
} // }
40 6 gcd writeln // print (gcd(40, 6))
// Exercise 1.20
206 40 gcd writeln // print (gcd(206, 40))
/* 1.2.6 Procedures and the Processes They Generate - Example: Testing for Primality */
// prime
define divides(a b) { b a mod 0 eq } // function divides(a, b) { return (b % a) == 0 }
define find_divisor(n test_divisor) { // function find_divisor(n, test_divisor) {
test_divisor square n > // if (square(test_divisor) > n)
[n] // return n
[test_divisor n divides // else if (divides(test_divisor, n))
[test_divisor] // return test_divisor
[n test_divisor 1 + find_divisor] // else
if] // return find_divisor(n, test_divisor + 1)
if // }
}
define smallest_divisor(n) { n 2 find_divisor } // function smallest_divisor(n) { return find_divisor(n, 2) }
define prime(n) { n n smallest_divisor eq } // function prime(n) { return n == smallest_divisor(n) }
// fast_prime
define expmod(nbase nexp m) { // function expmod(nbase, nexp, m) {
nexp 0 eq // if (nexp == 0)
[1] // return 1
[nexp even // else
[nbase nexp 2 / m expmod square m mod] // if (even(nexp))
[nbase nbase nexp 1 - m expmod * m mod] // return square(expmod(nbase, nexp / 2, m)) % m
if] // else
if // return (nbase * (expmod(nbase, (nexp - 1), m))) % m
} // }
// note: move nested functions outside for now
define try_it(a n) { a n n expmod a eq } // function try_it(a) { return expmod(a, n, n) == a }
define fermat_test(n) { // function fermat_test(n) {
n 1 - rnd_int 1 + n try_it // return try_it(1 + Math.round((Math.random()*n)-1))
} // }
define fast_prime(n ntimes) { // function fast_prime(n, ntimes) {
ntimes 0 eq // if (ntimes == 0) return true
[true] // else
[n fermat_test // if (fermat_test(n)) return fast_prime(n, ntimes - 1)
[n ntimes 1 - fast_prime] // else return false
[false] // }
if]
if
}
// Exercise 1.21
199 smallest_divisor writeln // print (smallest_divisor(199))
1999 smallest_divisor writeln // print (smallest_divisor(1999))
19999 smallest_divisor writeln // print (smallest_divisor(19999))
// Exercise 1.22
define report_prime(elapsed_time) { // function report_prime(elapsed_time) {
" *** " write elapsed_time writeln // print (" *** " + elapsed_time)
} // }
define start_prime_test(n start_time) { // function start_prime_test(n, start_time) {
n prime // if (prime(n)) {
[now start_time sub_time to_msec report_prime] // report_prime((new Date()).getTime() - start_time)
[] // }
if // }
}
define timed_prime_test(n) { // function timed_prime_test(n) {
n writeln // print ("\n" + n)
n now start_prime_test // start_prime_test(n, (new Date()).getTime())
} // }
// Exercise 1.25
define expmod(nbase nexp m) { // function expmod(nbase, nexp, m) {
nbase nexp fast_expt m mod // return fast_expt(nbase, nexp) % m
} // }
// Exercise 1.26
define expmod(nbase nexp m) { // function expmod(nbase, nexp, m) {
nexp 0 eq // if (nexp == 0)
[1] // return 1
[nexp even // else
[nbase nexp 2 / m expmod // if (even(nexp))
nbase nexp 2 / m expmod * m mod] // return (expmod(nbase, (nexp / 2), m) *
[nbase nbase nexp 1 - m expmod * m mod] // expmod(nbase, (nexp / 2), m)) % m
if] // else
if // return (nbase * expmod(nbase, nexp - 1, m)) % m
} // }
// Exercise 1.27
define carmichael(n) { // function carmichael(n) {
n 10 fast_prime n prime not and // return fast_prime(n, 100) && !prime(n)
} // }
561 carmichael writeln // print (carmichael(561))
1105 carmichael writeln // print (carmichael(1105))
1729 carmichael writeln // print (carmichael(1729))
2465 carmichael writeln // print (carmichael(2465))
2821 carmichael writeln // print (carmichael(2821))
6601 carmichael writeln // print (carmichael(6601))
/* 1.3 Formulating Abstractions with Higher-Order Procedures */
define cube(x) { x x * x * } // function cube(x) { return x * x * x }
/* 1.3.1 Formulating Abstractions with Higher-Order Procedures - Procedures as Arguments */
define sum_integers(a b) { // function sum_integers(a, b) {
a b > // if (a > b)
[0] // return 0
[a a 1 + b sum_integers +] // else
if // return a + sum_integers(a + 1, b)
} // }
define sum_cubes(a b) { // function sum_cubes(a, b) {
a b > // if (a > b)
[0] // return 0
[a cube a 1 + b sum_cubes +] // else
if // return cube(a) + sum_cubes(a + 1, b)
} // }
define pi_sum(a b) { // function pi_sum(a, b) {
a b > // if (a > b)
[0.0] // return 0.0
[1.0 a a 2.0 + * / a 4.0 + b pi_sum +] // else
if // return (1.0 / (a * (a + 2.0))) + pi_sum(a + 4.0, b)
} // }
define sum_int(term a next b) { // function sum_int(term, a, next, b) {
a b > // if (a > b)
[0] // return 0
[a term apply term a next apply next b sum_int +] // else
if // return term(a) + sum_int(term, next(a), next, b)
} // }
define sum_dbl(term a next b) { // function sum_dbl(term, a, next, b) {
a b > // if (a > b)
[0.0] // return 0.0
[a term apply term a next apply next b sum_dbl +] // else
if // return term(a) + sum_dbl(term, next(a), next, b)
} // }
// Using sum
define inc_(n) { n 1 + } // function inc_(n) { return n + 1; }
define sum_cubes(a b) { // function sum_cubes(a, b) {
[cube] a [inc_] b sum_int // return sum_int(cube, a, inc, b)
} // }
1 10 sum_cubes writeln // print (sum_cubes(1, 10))
define identity(x) { x } // function identity(x) { return x; }
define sum_integers(a b) { // function sum_integers(a, b) {
[identity] a [inc] b sum_int // return sum_int(identity, a, inc, b)
} // }
1 10 sum_integers writeln // print (sum_integers(1, 10))
// note: move nested functions outside for now
define pi_term(x) { 1.0 x x 2.0 + * / } // function pi_sum(a, b) {
define pi_next(x) { x 4.0 + } // function pi_term(x) { return 1.0 / (x * (x + 2.0)) }
define pi_sum(a b) { // function pi_next(x) { return x + 4.0 }
[pi_term] a [pi_next] b sum_dbl // return sum_dbl(pi_term, a, pi_next, b)
} // }
// note: 1000.0 runs out of stack space
8.0 1.0 200.0 pi_sum * writeln // print (8.0 * pi_sum(1.0, 1000.0))
// note: move nested functions outside for now
define add_dx(x dx) { x dx + } // function integral(f, a, b, dx) {
define integral(f a b dx) { // function add_dx(x) { return x + dx }
f a dx 2.0 / + dx quote [add_dx] compose b sum_dbl dx * // return sum(f, a + (dx / 2.0), add_dx, b) * dx
} // }
define cube(x) { x x * x * } // function cube(x) { return x * x * x }
// note: 0.01 runs out of stack space
[cube] 0.0 1.0 0.1 integral writeln // print (integral(cube, 0.0, 1.0, 0.01))
[cube] 0.0 1.0 0.001 integral writeln // print (integral(cube, 0.0, 1.0, 0.001))
// Exercise 1.29
// note: move nested functions outside for now
define sum_iter(h a term start next stop acc) { // function simpson(f, a, b, n) {
start stop > // var h = abs(b - a) / n
[acc] // function sum_iter(term, start, next, stop, acc) {
[h a term start next apply next stop // if (start > stop)
acc a start h * + term apply + sum_iter] // return acc
if // else
} // return sum_iter(term, next(start), next, stop, acc + term(a + start * h))
define simpson(f a b n) { // }
b a - abs_dbl n round_dbl / // return h * sum_iter(f, 1, inc, n, 0.0)
dup a f 1 [inc] n 0.0 sum_iter * // }
}
[cube] 0.0 1.0 100 simpson writeln // simpson(cube, 0.0, 1.0, 100)
// Exercise 1.30
define sum_iter(term a next b acc) { // function sum_iter(term, a, next, b, acc) {
a b > // if (a > b)
[acc] // return acc
[term a next apply next b acc a term apply + sum_iter] // else
if // return sum_iter(term, next(a), next, b, acc + term(a))
} // }
define sum_cubes(a b) { // function sum_cubes(a, b) {
[cube] a [inc] b 0 sum_iter // return sum_iter(cube, a, inc, b, 0)
} // }
1 10 sum_cubes writeln // print (sum_cubes(1, 10))
// Exercise 1.31
// a.
define product(term a next b) { // function product(term, a, next, b) {
a b > // if (a > b)
[1] // return 1
[a term apply term a next apply next b product *] // else
if // return term(a) * product(term, next(a), next, b)
} // }
define factorial(n) { // function factorial(n) {
[identity] 1 [inc] n product // return product(identity, 1, inc, n)
} // }
// b.
define product_iter(term a next b acc) { // function product_iter(term, a, next, b, acc) {
a b > // if (a > b)
[acc] // return acc
[term a next apply next b acc a term apply * product_iter] // else
if // return product_iter(term, next(a), next, b, acc * term(a))
} // }
define factorial(n) { // function factorial(n) {
[identity] 1 [inc] n 1 product_iter // return product_iter(identity, 1, inc, n, 1)
} // }
// Exercise 1.32
// a.
define accumulate(combiner nullValue term a next b) { // function accumulate(combiner, nullValue, term, a, next, b) {
a b > // if (a > b)
[nullValue] // return nullValue
[a term apply combiner nullValue term // else
a next apply next b accumulate combiner apply] // return combiner(term(a), accumulate(combiner, nullValue, term,
if // next(a), next, b))
} // }
define sum(a b) { // function sum(a, b) {
[+] 0 [identity] a [inc] b accumulate // return accumulate(plus, 0, identity, a, inc, b)
} // }
define product(a b) { // function product(a, b) {
[*] 1 [identity] a [inc] b accumulate // return accumulate(multiply, identity, a, inc, b, 1)
} // }
// b.
define accumulate_iter(combiner term a next b acc) { // function accumulate_iter(combiner, term, a, next, b, acc) {
a b > // if (a > b)
[acc] // return acc
[combiner term a next apply next b // else
acc a term apply combiner apply accumulate_iter] // return accumulate_iter(combiner, term, next(a), next, b,
if // combiner(acc, term(a)))
} // }
define sum(a b) { // function sum(a, b) {
[+] [identity] a [inc] b 0 accumulate_iter // return accumulate_iter(plus, identity, a, inc, b, 0)
} // }
define product(a b) { // function product(a, b) {
[*] [identity] a [inc] b 1 accumulate_iter // return accumulate_iter(multiply, identity, a, inc, b, 1)
} // }
// Exercise 1.33
define filtered_accumulate(combiner nullValue term a next b pred) { // function filtered_accumulate(combiner, nullValue, term, a, next, b, pred) {
a b > // if (a > b)
[nullValue] // return nullValue
[a pred apply // else if (pred(a))
[a term apply combiner nullValue term a next apply // return combiner(term(a),
next b pred filtered_accumulate combiner apply] // filtered_accumulate(combiner, nullValue, term, next(a), next, b, pred))
[combiner nullValue term a next apply // else
next b pred filtered_accumulate] // return filtered_accumulate(combiner, nullValue, term, next(a), next, b, pred)
if] // }
if
}
// a.
[plus] 0 [square] 1 [inc] 5 [prime] filtered_accumulate writeln // print (filtered_accumulate(plus, 0, square, 1, inc, 5, prime)) // 39
/* 1.3.2 Formulating Abstractions with Higher-Order Procedures - Constructing Procedures Using Lambda */
define pi_sum(a b) { // define pi_sum(a b) {
[id dup 2.0 + * 1.0 swap /] // return sum(
a // function(x) { return 1.0 / (x * (x + 2.0)) },
[id 4.0 +] // a,
b // function(x) { return x + 4.0 },
sum_dbl // b)
} // }
define integral(f a b dx) { // function integral(f, a, b, dx) {
f // return sum(
a dx 2.0 / + // f,
[id] dx quote compose [+] compose // a + (dx / 2.0),
b // function(x) { return x + dx },
sum_dbl dx * // b) * dx
} // }
define plus4(x) { x 4 + } // function plus4(x) { return x + 4 }
define plus4 { [id 4 +] apply } // plus4 = function(x) { return x + 4 }
define f(x y z) { x y + z square + } // print ((function(x, y, z) { return x + y + square(z) }) (1, 2, 3))
1 2 3 f writeln
//ToBeDone: // Using let
//ToBeDone: function f(x, y) {
//ToBeDone: function f_helper(a, b) {
//ToBeDone: return x*square(a) + y*b + a*b
//ToBeDone: }
//ToBeDone: return f_helper(1 + x*y, 1 - y)
//ToBeDone: }
//ToBeDone:
//ToBeDone: function f(x, y) {
//ToBeDone: return (function(a, b) { return x*square(a) + y*b + a*b }) (1 + x*y, 1 - y)
//ToBeDone: }
//ToBeDone:
//ToBeDone: function f(x, y) {
//ToBeDone: a = 1 + x*y
//ToBeDone: b = 1 - y
//ToBeDone: return x*square(a) + y*b + a*b
//ToBeDone: }
//ToBeDone:
//ToBeDone: // cat does not have let binding - used lambda to emulate
//ToBeDone: var x = 5
//ToBeDone: print (function() {
//ToBeDone: var x = 3
//ToBeDone: return x + (x * 10)
//ToBeDone: }() + x)
//ToBeDone:
//ToBeDone: var x = 2
//ToBeDone: print (function(x) {
//ToBeDone: var y = x + 2
//ToBeDone: var x = 3
//ToBeDone: return x * y
//ToBeDone: }(x))
//ToBeDone:
//ToBeDone: function f(x, y) {
//ToBeDone: a = 1 + x*y
//ToBeDone: b = 1 - y
//ToBeDone: return x*square(a) + y*b + a*b
//ToBeDone: }
// Exercise 1.34
define f(g) { 2 g apply } // function f(g) { return g(2) }
[square] f writeln // print (f(square))
[id dup 1 + *] f writeln // print (f(function(z) { return z * (z + 1) } ))
/* 1.3.3 Formulating Abstractions with Higher-Order Procedures - Procedures as General Methods */
// Half-interval method
define close_enough(x y) { // function close_enough(x, y) {
x y - abs_dbl 0.001 < // return abs(x - y) < 0.001
} // }
define positive(x) { x 0.0 >= } // function positive(x) { return x >= 0.0 }
define negative(x) { x positive not } // function negative(x) { return !(positive(x)) }
define search(f neg_point pos_point) { // function search(f, neg_point, pos_point) {
neg_point pos_point close_enough // midpoint = average(neg_point, pos_point)
[neg_point pos_point average] // if (close_enough(neg_point, pos_point))
[neg_point pos_point average f apply positive // return midpoint
[f neg_point neg_point pos_point average search] // else
[neg_point pos_point average f apply negative // test_value = f(midpoint)
[f neg_point pos_point average pos_point search] // if (positive(test_value))
[neg_point pos_point average] // return search(f, neg_point, midpoint)
if] // else if (negative(test_value))
if] // return search(f, midpoint, pos_point)
if // else return midpoint
} // }
define half_interval_method(f a b) { // function half_interval_method(f, a, b) {
a f apply negative b f apply positive and // a_value = f(a)
[f a b search] // b_value = f(b)
[b f apply negative a f apply positive and // if (negative(a_value) && positive(b_value))
[f b a search] // return search(f, a, b)
["Exception: Values are not of opposite sign " // else if (negative(b_value) && positive(a_value))
a str + " " + b str + throw] // return search(f, b, a)
if] // else
if // throw ("Exception: Values are not of opposite sign " + a + " " + b)
} // }
[sin_dbl] 2.0 4.0 half_interval_method writeln // print (half_interval_method(Math.sin, 2.0, 4.0))
define f(x) { x x * x * 2.0 x * - 3.0 - } // print (half_interval_method(function(x) { return x*x*x - 2.0*x - 3.0 }, 1.0, 2.0))
[f] 1.0 2.0 half_interval_method writeln
// Fixed points
define tolerance { 0.00001 } // var tolerance = 0.00001
define close_enough(v1 v2) { // function fixed_point(f, first_guess) {
v1 v2 - abs_dbl tolerance < // function close_enough(v1, v2) {
} // return abs(v1 - v2) < tolerance
define tryit(f guess) { // }
guess guess f apply close_enough // function tryit(guess) {
[guess f apply] // next = f(guess)
[f guess f apply tryit] // if (close_enough(guess, next))
if // return next
} // else return tryit(next)
define fixed_point(f first_guess) { // }
f first_guess tryit // return tryit(first_guess)
} // }
[cos_dbl] 1.0 fixed_point writeln // print (fixed_point(Math.cos, 1.0))
define f(x) { x sin_dbl x cos_dbl + } // print (fixed_point(function(y) { return Math.sin(y) + Math.cos(y) }, 1.0))
[f] 1.0 fixed_point writeln
|