home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / ABE&SUS1.ZIP / A&S_1.LSP
Encoding:
Text File  |  1987-04-06  |  9.9 KB  |  496 lines
  1.  
  2. ;;; Section 1.1.4
  3.  
  4. (define (square x) (* x x))
  5.  
  6. (define (sum-of-squares x y)
  7.   (+ (square x) (square y)))
  8.  
  9. (define (f a)
  10.   (sum-of-squares (+ a 1) (* a 2)))
  11.  
  12.  
  13. ;;; Section 1.1.6 -- several versions of ABS
  14.  
  15. (define (abs x)
  16.   (cond ((> x 0) x)
  17.         ((= x 0) 0)
  18.         ((< x 0) (- x))))
  19.  
  20. (define (abs x)
  21.   (cond ((< x 0) (- x))
  22.         (else x)))
  23.  
  24. (define (abs x)
  25.   (if (< x 0)
  26.       (- x)
  27.       x))
  28.  
  29. ;;; some arithmetic predicates
  30.  
  31. (define (>= x y)
  32.   (or (> x y) (= x y)))
  33.  
  34. (define (>= x y)
  35.   (not (< x y)))
  36.  
  37. ;;; Exercise 1.3
  38.  
  39. (define (p) (p))
  40.  
  41. (define (test x y)
  42.   (if (= x 0)
  43.       0
  44.       y))
  45.  
  46. (test 0 (p))
  47.  
  48. ;;; Section 1.1.7 -- square roots
  49.  
  50. (define (sqrt-iter guess x)
  51.   (if (good-enough? guess x)
  52.       guess
  53.       (sqrt-iter (improve guess x)
  54.                  x)))
  55.  
  56. (define (improve guess x)
  57.   (average guess (/ x guess)))
  58.  
  59. (define (average x y)
  60.   (/ (+ x y) 2))
  61.  
  62. (define (good-enough? guess x)
  63.   (< (abs (- (square guess) x)) .001))
  64.  
  65. (define (sqrt x)
  66.   (sqrt-iter 1 x))
  67.  
  68. ;;; Exercise 1.4
  69.  
  70. (define (new-if predicate then-clause else-clause)
  71.   (cond (predicate then-clause)
  72.         (else else-clause)))
  73.  
  74. (define (sqrt-iter guess x)
  75.   (new-if (good-enough? guess x)
  76.           guess
  77.           (sqrt-iter (improve guess x)
  78.                      x)))
  79.  
  80. ;;; Section 1.1.8
  81.  
  82. ;;; another verson of SQUARE
  83.  
  84. (define (square x) 
  85.   (exp (double (log x))))
  86.  
  87. (define (double x) (+ x x))
  88.  
  89. ;;; Reinstate the simple version
  90.  
  91. (define (square x) (* x x))
  92.  
  93. ;;; Block-structured SQRT
  94.  
  95. (define (sqrt x)
  96.   (define (good-enough? guess x)
  97.     (< (abs (- (square guess) x)) .001))
  98.   (define (improve guess x)
  99.     (average guess (/ x guess)))
  100.   (define (sqrt-iter guess x)
  101.     (if (good-enough? guess x)
  102.         guess
  103.         (sqrt-iter (improve guess x) x)))
  104.   (sqrt-iter 1 x))
  105.  
  106. ;;; Block-structured SQRT using lexical scoping
  107.  
  108. (define (sqrt x)
  109.   (define (good-enough? guess)
  110.     (< (abs (- (square guess) x)) .001))
  111.   (define (improve guess)
  112.     (average guess (/ x guess)))
  113.   (define (sqrt-iter guess)
  114.     (if (good-enough? guess)
  115.         guess
  116.         (sqrt-iter (improve guess))))
  117.   (sqrt-iter 1))
  118.  
  119. ;;; Section 1.2.1
  120.  
  121. ;;; Recursive FACTORIAL
  122.  
  123. (define (factorial n)
  124.   (if (= n 1)
  125.       1
  126.       (* n (factorial (- n 1)))))
  127.  
  128. ;;; Iterative FACTORIAL
  129.  
  130. (define (factorial n)
  131.   (fact-iter 1 1 n))
  132.  
  133. (define (fact-iter product counter max-count)
  134.   (if (> counter max-count)
  135.       product
  136.       (fact-iter (* counter product)
  137.                  (+ counter 1)
  138.                  max-count)))
  139.  
  140. ;;; Iterative FACTORIAL -- block-structured version
  141.  
  142. (define (factorial n)
  143.   (define (iter product counter)
  144.     (if (> counter n)
  145.         product
  146.         (iter (* counter product)
  147.               (+ counter 1))))
  148.   (iter 1 1))
  149.  
  150. ;;; Exercise 1.7
  151. (define (+ a b)
  152.   (if (= a 0)
  153.       b
  154.       (1+ (+ (-1+ a) b))))
  155.  
  156. (define (+ a b)
  157.   (if (= a 0)
  158.       b
  159.       (+ (-1+ a) (1+ b))))
  160.  
  161. ;;; Exercise 1.8
  162.  
  163. (define (A x y)
  164.   (cond ((= y 0) 0)
  165.         ((= x 0) (* 2 y))
  166.         ((= y 1) 2)
  167.         (else (A (- x 1)
  168.                  (A x (- y 1))))))
  169.  
  170. (define (f n) (A 0 n))
  171.  
  172. (define (g n) (A 1 n))
  173.  
  174. (define (h n) (A 2 n))
  175.  
  176. (define (k n) (* 5 n n))
  177.  
  178.  
  179. ;;; Section 1.2.2
  180.  
  181. ;;; Recursive FIB
  182.  
  183. (define (fib n)
  184.   (cond ((= n 0) 0)
  185.         ((= n 1) 1)
  186.         (else (+ (fib (- n 1))
  187.                  (fib (- n 2))))))
  188.  
  189. ;;; Iterative FIB
  190. (define (fib n)
  191.   (fib-iter 1 0 n))
  192.  
  193. (define (fib-iter a b count)
  194.   (if (= count 0)
  195.       b
  196.       (fib-iter (+ a b) a (- count 1))))
  197.  
  198. ;;; Counting change
  199. (define (count-change amount)
  200.   (cc amount 5))
  201.  
  202. (define (cc amount kinds-of-coins)
  203.   (cond ((= amount 0) 1)
  204.         ((or (< amount 0) (= kinds-of-coins 0)) 0)
  205.         (else (+ (cc (- amount
  206.                         (first-denomination kinds-of-coins))
  207.                      kinds-of-coins)
  208.                  (cc amount
  209.                      (- kinds-of-coins 1))))))
  210.  
  211. (define (first-denomination kinds-of-coins)
  212.   (cond ((= kinds-of-coins 1) 1)
  213.         ((= kinds-of-coins 2) 5)
  214.         ((= kinds-of-coins 3) 10)
  215.         ((= kinds-of-coins 4) 25)
  216.         ((= kinds-of-coins 5) 50)))
  217.  
  218. ;;; Section 1.2.4 -- exponentiation
  219.  
  220. ;;; Linear recursive version
  221.  
  222. (define (expt b n)
  223.   (if (= n 0)
  224.       1
  225.       (* b (expt b (- n 1)))))
  226.  
  227. ;;; Linear iterative version
  228.  
  229. (define (expt b n)
  230.   (exp-iter b n 1))
  231.  
  232. (define (exp-iter b counter product)
  233.   (if (= counter 0)
  234.       product
  235.       (exp-iter b
  236.                 (- counter 1)
  237.                 (* b product)))) 
  238.  
  239. ;;; Logarithmic recursive version
  240. (define (fast-exp b n)
  241.   (cond ((= n 0) 1)
  242.         ((even? n) (square (fast-exp b (/ n 2))))
  243.         (else (* b (fast-exp b (- n 1))))))
  244.  
  245. (define (even? n)
  246.   (= (remainder n 2) 0))
  247.  
  248. ;;; Exercise 1.12
  249.  
  250. (define (* a b)
  251.   (if (= b 0)
  252.       0
  253.       (+ a (* a (- b 1)))))
  254.  
  255. ;;; Section 1.2.5 -- Greatest common divisor
  256.  
  257. (define (gcd a b)
  258.   (if (= b 0)
  259.       a
  260.       (gcd b (remainder a b))))
  261.  
  262. ;;; Section 1.2.6 -- Primality
  263.  
  264. (define (smallest-divisor n)
  265.   (find-divisor n 2))
  266.  
  267. (define (find-divisor n test-divisor)
  268.   (cond ((> (square test-divisor) n) n)
  269.         ((divides? test-divisor n) test-divisor)
  270.         (else (find-divisor n (+ test-divisor 1)))))
  271.  
  272. (define (divides? a b)
  273.   (= (remainder b a) 0))
  274.  
  275. (define (prime? n)
  276.   (= n (smallest-divisor n)))
  277.  
  278. (define (expmod b e m)
  279.   (cond ((= e 0) 1)
  280.         ((even? e)
  281.          (remainder (square (expmod b (/ e 2) m))
  282.                     m))
  283.         (else
  284.          (remainder (* b (expmod b (- e 1) m))
  285.                     m))))        
  286.  
  287. (define (fermat-test n)
  288.   (define a (+ 2 (random (- n 2))))
  289.   (= (expmod a n n) a))
  290.  
  291. (define (fast-prime? n times)
  292.   (cond ((= times 0) t)
  293.         ((fermat-test n)
  294.          (fast-prime? n (- times 1)))
  295.         (else nil)))
  296.  
  297. ;;; Exercise 1.17
  298.  
  299. (define (timed-prime-test n)
  300.   (define start-time (runtime))
  301.   (define found-prime? (prime? n))
  302.   (define elapsed-time (- (runtime) start-time))
  303.   (print n)
  304.   (cond (found-prime?
  305.          (print " *** ")
  306.          (print elapsed-time))))
  307.  
  308. ;;; Exercise 1.20
  309.  
  310. (define (expmod base exp m)
  311.   (remainder (fast-exp base exp) m))
  312.  
  313. ;;; Exercise 1.21
  314.  
  315. (define (expmod b e m)
  316.   (cond ((= e 0) 1)
  317.         ((even? e)
  318.          (remainder (* (expmod b (/ e 2) m)
  319.                        (expmod b (/ e 2) m))
  320.                     m))
  321.         (else
  322.          (remainder (* b (expmod b (- e 1) m))
  323.                     m))))
  324.  
  325. ;;; Section 1.3
  326.  
  327. (define (cube x) (* x x x))
  328.  
  329. ;;; Section 1.3.1
  330.  
  331. (define (sum-integers a b)
  332.   (if (> a b)
  333.       0
  334.       (+ a (sum-integers (+ a 1) b))))
  335.  
  336. (define (sum-cubes a b)
  337.   (if (> a b)
  338.       0
  339.       (+ (cube a) (sum-cubes (+ a 1) b))))
  340.  
  341. (define (pi-sum a b)
  342.   (if (> a b)
  343.       0
  344.       (+ (/ 1 (* a (+ a 2))) (pi-sum (+ a 4) b))))
  345.  
  346. (define (sum term a next b)
  347.   (if (> a b)
  348.       0
  349.       (+ (term a)
  350.          (sum term (next a) next b))))
  351.  
  352. (define (sum-cubes a b)
  353.   (sum cube a 1+ b))
  354.  
  355. (define (pi-sum a b)
  356.   (define (pi-term x)
  357.     (/ 1 (* x (+ x 2))))
  358.   (define (pi-next x)
  359.     (+ x 4))
  360.   (sum pi-term a pi-next b))
  361.  
  362. (define (integral f a b dx)
  363.   (define (add-dx x) (+ x dx))
  364.   (* (sum f (+ a (/ dx 2)) add-dx b)
  365.      dx))
  366.  
  367. ;;; Section 1.3.2
  368.  
  369. (define (pi-sum a b)
  370.   (sum (lambda (x) (/ 1 (* x (+ x 2))))
  371.        a
  372.        (lambda (x) (+ x 4))
  373.        b))
  374.  
  375. (define (integral f a b dx)
  376.   (* (sum f
  377.           (+ a (/ dx 2))
  378.           (lambda (x) (+ x dx))
  379.           b)
  380.      dx))
  381.  
  382. ;;; Four equivalent procedure definitions
  383.  
  384. (define (f x y)
  385.   (define a (+ 1 (* x y)))
  386.   (define b (- 1 y))
  387.   (+ (* x (square a))
  388.      (* y b)
  389.      (* a b)))
  390.  
  391. (define (f x y)
  392.   (define (f-helper a b)
  393.     (+ (* x (square a))
  394.        (* y b)
  395.        (* a b)))
  396.   (f-helper (+ 1 (* x y)) 
  397.             (- 1 y)))
  398.  
  399. (define (f x y)
  400.   ((lambda (a b)
  401.      (+ (* x (square a))
  402.         (* y b)
  403.         (* a b)))
  404.    (+ 1 (* x y))
  405.    (- 1 y)))
  406.  
  407. (define (f x y)
  408.   (let ((a (+ 1 (* x y)))
  409.         (b (- 1 y)))
  410.     (+ (* x (square a))
  411.        (* y b)
  412.        (* a b))))
  413.  
  414. ;;; Exercise 1.28
  415.  
  416. (define (f g)
  417.   (g 2))
  418.  
  419. ;;; Section 1.3.3
  420.  
  421. ;;; Half-interval method
  422.  
  423. (define (search f neg-point pos-point)
  424.   (let ((midpoint (average neg-point pos-point)))
  425.     (if (close-enough? neg-point pos-point)
  426.         midpoint
  427.         (let ((test-value (f midpoint)))
  428.           (cond ((positive? test-value)
  429.                  (search f neg-point midpoint))
  430.                 ((negative? test-value)
  431.                  (search f midpoint pos-point))
  432.                 (else midpoint))))))
  433.  
  434. (define (close-enough? x y)
  435.   (< (abs (- x y)) .001))
  436.  
  437. (define (half-interval-method f a b)
  438.   (let ((a-value (f a))
  439.         (b-value (f b)))
  440.     (cond ((and (negative? a-value) (positive? b-value))
  441.            (search f a b))
  442.           ((and (negative? b-value) (positive? a-value))
  443.            (search f b a))
  444.           (else
  445.            (error "Values are not of opposite sign" a b)))))
  446.  
  447. ;;; Golden section method
  448.  
  449. (define (reduce f a x y b fx fy)
  450.   (cond ((close-enough? a b) x)
  451.         ((> fx fy)
  452.          (let ((new (x-point a y)))
  453.            (reduce f a new x y (f new) fx)))
  454.         (else
  455.          (let ((new (y-point x b)))
  456.            (reduce f x y new b fy (f new))))))
  457.  
  458. (define (x-point a b)
  459.   (+ a (* golden-ratio-squared (- b a))))
  460.  
  461. (define (y-point a b)
  462.   (+ a (* golden-ratio (- b a))))
  463.  
  464. (define golden-ratio
  465.   (/ (- (sqrt 5) 1) 2))
  466.  
  467. (define golden-ratio-squared (square golden-ratio))
  468.  
  469. (define (golden f a b)
  470.   (let ((x (x-point a b))
  471.         (y (y-point a b)))
  472.     (reduce f a x y b (f x) (f y))))
  473.  
  474. ;;; Section 1.3.4
  475.  
  476. ;;; Derivative of a function
  477.  
  478. (define (deriv f dx)
  479.   (lambda (x)
  480.     (/ (- (f (+ x dx)) (f x))
  481.        dx)))
  482.  
  483. ;;; Newton's method
  484.  
  485. (define (newton f guess)
  486.   (if (good-enough? guess f)
  487.       guess
  488.       (newton f (improve guess f))))
  489.  
  490. (define (improve guess f)
  491.   (- guess (/ (f guess)
  492.               ((deriv f .001) guess))))
  493.  
  494. (define (good-enough? guess f)
  495.   (< (abs (f guess)) .001))
  496. (38)%