SICPゼミ第8回

練習問題2.33

(define nil '())

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

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) nil sequence ))

(define (append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length sequence)
  (accumulate (lambda (x y) (+ y 1)) 0 sequence ))

by pine

(define (map p sequence)
  (accumulate (lambda (x y) (cons (p (car sequence)) (map p (cdr sequence)) )) nil sequence))

練習問題2.34

(define (honor-eval x coefficient-seq)
  (accumulate (lambda (this-coeff higher-terms) (+ (* higher-terms x) this-coeff))
              0
              coefficient-seq))

by tube

練習問題2.35

(define (count-leaves t)
  (accumulate + 0 (map 
                    (lambda (x) (if (not (pair? x)) 
                                    1
                                    (count-leaves x)))
                    t)))

by pine

練習問題2.36

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      null
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

実行結果

(define sample (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
> (accumulate-n + 0 sample)
'(22 26 30)

by tube

練習問題2.37

(define matrix1 (list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9)))
(define vector (list 1 2 3 4))
(define matrix2 (list (list 1 4 6) (list 2 5 7) (list 3 6 8) (list 4 6 9)))

(define (dot-product v w)
(accumulate + 0 (map * v w)))

(define (matrix-*-vector m v)
	(map (lambda (vec) (dot-product vec v)) m))

(define (transpose mat)
 (accumulate-n cons nil mat))

(define (matrix-*-matrix m n)
	(let ((cols (transpose n)))
		(map (lambda (vec) (matrix-*-vector cols vec)) m)))

実行結果

(matrix-*-matrix matrix1 matrix2)
((30 56 80) (56 113 161) (80 161 230))

by どりきゃす

練習問題2.38

可換性

練習問題2.39

(define (reverse sequence)
  (fold-right (lambda (x y) (append y (list x))) nil sequence ))

(define (reverse sequence)
  (fold-left (lambda (x y) (append (list y) x)) nil sequence ))

(define (reverse sequence)
  (fold-left (lambda (x y) (cons y x)) nil sequence ))

fold-leftだとconsでOK
by pine

練習問題2.40

(define (unique-pairs n)
(accumulate append nil (map (lambda (i) (map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs n))))

練習問題2.41

(define (find-sum-of-s-pairs n s) 
	(define (generate-3-pairs n) 
		(flatmap (lambda (x) 
			(map (lambda (y) (append y (list x)))
				(unique-pairs (- x 1))
				)
			)
		(enumerate-interval 1 n))
		)
	(define (is-sum-s? l)
		(= s (+ (car l) (cadr l) (caddr l)))
		)
	(filter is-sum-s? (generate-3-pairs n))
	)

by どりきゃす

(define (find-sum-of-s-pairs s n)
  (define (sum-is-s? x)
    (= (accumulate + 0 x) s))
  (define (ls n)
    (accumulate append nil
                (map (lambda (i)
                       (map (lambda (x) (append (list i) x)) (unique-pairs (- i 1))))
                     (enumerate-interval 1 n))))
  (accumulate (lambda (x y) (if (sum-is-s? x)
                                (append (list x) y)
                                y))
              nil
              (ls n)))

by pine

練習問題2.42

(define empty-board '())
(define (adjoin-position row col rest)
  (cons (cons row col) rest))
(define (safe?-sub p rest)
  (if (null? rest)
      #t
      (cond ((= (caar rest) (car p)) #f)
            ((= (abs (- (car (car rest)) (car p)))
                (- (cdr p) (cdr (car rest)))) #f)
            (else (safe?-sub p (cdr rest))))))
(define (safe? k positions)
  (let ((col (car positions)))
    (safe?-sub col (cdr positions))))
  

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position
                    new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

by tube