Scheme - データによる抽象の構築(階層データ構造と閉包性(公認インターフェースとしての並び(並びの演算)))

計算機プログラムの構造と解釈[第2版]
原著

開発環境

• macOS Sierra - Apple (OS)
• Emacs (Text Editor)
• Scheme (プログラミング言語)
• kscheme (ksi)(github) (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第2章(データによる抽象の構築)、2.2(階層データ構造と閉包性)、2.2.3(公認インターフェースとしての並び)、並びの演算、問題2.33、34、35、36、37、38、39.を取り組んでみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題2.33、34、35、36、37、38、39.

コード(Emacs)

(begin
  (load "procedures.scm")
  (newline)
  (define (p obj) (display obj) (newline))

  (define (accumulate op initial sequence)
    (if (null? sequence)
        initial
        (op (car sequence)
            (accumulate op initial (cdr sequence)))))

  (p '2.33)
  (define (my-map p sequence)
    (accumulate (lambda (x y) (cons (p x) y)) '() sequence))

  (define (append seq1 seq2)
    (accumulate cons seq2 seq1))
  
  (define (length sequence)
    (accumulate (lambda (x y) (+ 1 y)) 0 sequence))
  
  (define nums '(1 2 3 4 5))
  (p (my-map square nums))
  (p (append nums '(6 7 8 9 0 100)))
  (p (length '()))
  (p (length nums))

  (p '2.34)
  (define (horner-eval x coefficient-sequence)
    (accumulate (lambda (this-coeff higher-terms)
                  (+ this-coeff (* higher-terms x)))
                0
                coefficient-sequence))
  (p (horner-eval 2 (list 1 3 0 5 0 1)))

  (p '2.35)
  (define (count-leaves t)
    (accumulate + 0 (map (lambda (leave)
                           (if (pair? leave)
                               (count-leaves leave)
                               1))
                         t)))
  (define tree (list 1 (list 2 (list 3 4))))  
  (p (count-leaves tree))

  (p '2.36)
  (define (accumulate-n op init seqs)
    (if (null? (car seqs))
        '()
        (cons (accumulate op init (map car seqs))
              (accumulate-n op init (map cdr seqs)))))
  (define s '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))
  (p (accumulate-n + 0 s))

  (p '2.37)
  (define (dot-product v w)
    (accumulate + 0 (map * v w)))
  (define (matrix-*-vector m v)
    (map (lambda (w) (dot-product w v)) m))
  (define (transpose mat)
    (accumulate-n cons '() mat))
  (define (matrix-*-matrix m n)
    ((lambda (cols)
       (map (lambda (row)
              (matrix-*-vector cols row))
            m))
     (transpose n)))
  (define (matrix-print mat)
    (p 'matrix)
    (for-each (lambda (row)
                (display row)
                (newline))
              mat)
    (p 'matrix-end))
  (define v1 '(1 2 3 4))
  (define v2 '(4 5 6 6))
  (define v3 '(6 7 8 9))
  (define m (list v1 v2 v3))

  (p (dot-product v1 v2))
  (p (matrix-*-vector m v1))
  (matrix-print (transpose m))
  (matrix-print (matrix-*-matrix m m))

  (p '2.38)
  (define fold-right accumulate)
  (define (fold-left op initial sequence)
    (define (iter result rest)
      (if (null? rest)
          result
          (iter (op result (car rest))
                (cdr rest))))
    (iter initial sequence))

  (p (= (fold-right / 1 (list 1 2 3)) 3/2))
  (p (= (fold-left / 1 (list 1 2 3)) 1/6))
  (p (equal? (fold-right list '() (list 1 2 3)) '(1 (2 (3 ())))))
  (p (equal? (fold-left list '() (list 1 2 3)) '(((() 1) 2) 3)))

  (p '2.39)
  (define (reverse-1 sequence)
    (fold-right (lambda (x y) (append y (list x))) '() sequence))
  (define (reverse-2 sequence)
    (fold-left (lambda (x y) (cons y x)) '() sequence))
  (p (reverse-1 nums))
  (p (reverse-2 nums))

  'done)

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ ksi < sample33.scm
ksi> 
2.33
(1 4 9 16 25)
(1 2 3 4 5 6 7 8 9 0 100)
0
5
2.34
79
2.35
4
2.36
(22 26 30)
2.37
56
(30 56 80)
matrix
(1 4 6)
(2 5 7)
(3 6 8)
(4 6 9)
matrix-end
matrix
(27 33 39 43)
(60 75 90 100)
(82 103 124 138)
matrix-end
2.38
#t
#t
#t
#t
2.39
(5 4 3 2 1)
(5 4 3 2 1)
=> done
ksi> $