fork download 
  1. ;; SICP - Ch. 2, Exercise (4)
  2. ;; @see 2L98t5
  3.  
  4. (define (square x)
  5.   (* x x))
  6.  
  7. (define (accumulate op init seq)
  8.   (if (null? seq)
  9.       init
  10.       (op (car seq)
  11.           (accumulate op init (cdr seq)))))
  12.  
  13. ;; 2.33: Fill in the missing expressions to complete
  14. ;; the following definitions of some basic list-manipulation
  15. ;; operations as accumulations:
  16.  
  17. (define (my-map proc seq)
  18.   (accumulate (lambda (x y) (cons (proc x) y)) '() seq))
  19.  
  20. (define (my-append seq1 seq2)
  21.   (accumulate cons seq2 seq1))
  22.  
  23. (define (my-length seq)
  24.   (accumulate (lambda (_ y) (+ 1 y)) 0 seq))
  25.  
  26. (define x (list 1 2 3 4))
  27. (define y (list 5 6 7))
  28.  
  29. (format #t "~%~A" (my-map square x))
  30. (format #t "~%~A" (my-append x y))
  31. (format #t "~%~A" (my-length x))
  32.  
  33. ;; 2.34: Fill in the following template to produce a procedure
  34. ;; that evaluates a polynomial using Horner’s rule.
  35.  
  36. (define (horner-eval x coefficient-sequence)
  37.   (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* x higher-terms)))
  38.               0
  39.               coefficient-sequence))
  40.  
  41. ;; 1 + 3x + 5x^3 + x^5 at x = 2
  42. (format #t "~%~A" (horner-eval 2 (list 1 3 0 5 0 1)))
  43.  
  44. ;; 2.35: Redefine count-leaves as an accumulation:
  45.  
  46. (define (count-leaves t)
  47.   (accumulate + 0 (map (lambda (x) (if (pair? x) (count-leaves x) 1)) t)))
  48.  
  49. (define x (cons (list 1 2) (list 3 4)))
  50.  
  51. (format #t "~%~A" (count-leaves x))
  52. (format #t "~%~A" (count-leaves (list x x)))
  53.  
  54. ;; 2.36: Fill in the missing expressions in the following definition
  55. ;; of accumulate-n:
  56.  
  57. (define (accumulate-n op init seqs)
  58.   (if (null? (car seqs))
  59.       '()
  60.       (cons (accumulate op init (map car seqs))
  61.             (accumulate-n op init (map cdr seqs)))))
  62.  
  63. (define x (list (list 1 2 3)
  64.                 (list 4 5 6)
  65.                 (list 7 8 9)
  66.                 (list 10 11 12)))
  67.  
  68. (format #t "~%~A" (accumulate-n + 0 x))
  69.  
  70. ;; 2.37: Fill in the missing expressions in the following procedures
  71. ;; for computing the other matrix operations.
  72.  
  73. (define (dot-product v w)
  74.   (accumulate + 0 (map * v w)))
  75.  
  76. (define (matrix-*-vector m v)
  77.   (map (lambda (w) (dot-product v w)) m))
  78.  
  79. (define (transpose m)
  80.   (accumulate-n cons '() m))
  81.  
  82. (define (matrix-*-matrix m n)
  83.   (let ((cols (transpose n)))
  84.     (map (lambda (row) (matrix-*-vector cols row)) m)))
  85.  
  86. (define x (list (list 1 2 3 4)
  87.                 (list 4 5 6 6)
  88.                 (list 6 7 8 9)))
  89.  
  90. (format #t "~%~A" (matrix-*-vector x (list 1 1 1 1)))
  91. (format #t "~%~A" (transpose x))
  92. (format #t "~%~A" (matrix-*-matrix x (transpose x)))
  93.  
  94. ;; 2.38: The accumulate procedure is also known as fold-right, because
  95. ;; it combines the first element of the sequence with the result of
  96. ;; combining all the elements to the right. There is also a fold-left,
  97. ;; which is similar to fold-right, except it combines elements working
  98. ;; in the opposite direction:
  99.  
  100. (define (fold-right op init seq)
  101.   (accumulate op init seq))
  102.  
  103. (define (fold-left op init seq)
  104.   (define (iter result rest)
  105.     (if (null? rest)
  106.         result
  107.         (iter (op result (car rest))
  108.               (cdr rest))))
  109.   (iter init seq))
  110.  
  111. (define x (list 1 2 3))
  112.  
  113. (format #t "~%~A" (fold-right / 1 x))
  114. (format #t "~%~A" (fold-left / 1 x))
  115. (format #t "~%~A" (fold-right list '() x))
  116. (format #t "~%~A" (fold-left list '() x))
  117.  
  118. ;; 2.39: Complete the following definitions of reverse (Exercise 2.18)
  119. ;; in terms of fold-right and fold-left from Exercise 2.38:
  120.  
  121. (define (my-reverse-r seq)
  122.   (fold-right (lambda (x y) (append y (list x))) '() seq))
  123.  
  124. (define (my-reverse-l seq)
  125.   (fold-left (lambda (x y) (cons y x)) '() seq))
  126.  
  127. (format #t "~%~A" (my-reverse-r x))
  128. (format #t "~%~A" (my-reverse-l x))
Success #stdin #stdout 0.01s 7948KB
comments (?)
stdin 
Standard input is empty
stdout 
(1 4 9 16)
(1 2 3 4 5 6 7)
4
79
4
8
(22 26 30)
(10 21 30)
((1 4 6) (2 5 7) (3 6 8) (4 6 9))
((30 56 80) (56 113 161) (80 161 230))
1.5
0.166666666666667
(1 (2 (3 ())))
(((() 1) 2) 3)
(3 2 1)
(3 2 1)
https://ideone.com/mqSL0s
language:
Scheme (chicken 4.13)
created:
87 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!