計算機プログラムの構造と解釈 第二版 P72 問題2.40

実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

(use ggc.debug.trace)
(use math.mt-random)

(define nil '())

(define (square n)
  (* n n)) 


;;prime? の実装
(define (smallest-divisor n)
  (find-divisor n 2)) 

(define (divides? a b)
  (= (remainder b a) 0)) 


(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides?  test-divisor n) test-divisor)
        (else (find-divisor n (cond ((= test-divisor 2) 3 ) 
                                    (else (+ test-divisor 2)))))))
(define (prime? n)
  (cond ((= n (smallest-divisor n)) #t) 
  (else #f)))
;; prime?終わり。


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


(define (enumerate-interval low high)
  (if (> low high)
    nil
    (cons low (enumerate-interval (+ low 1) high))))


(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))


;;; Blow is the contents of p71-72
(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))


(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))


(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))


(define (permutations s)
  (if (null? s)
    (list nil)
    (flatmap (lambda (x)
               (map (lambda (p) (cons x p))
                    (permutations (remove x s))))
             s)))


(define (remove item sequence)
  (filter (lambda (x) (not (= x item)))
          sequence))



;これは参考までに解説の部分でのprime-sum-pairs
;(define (prime-sum-pairs n)
;  (map make-pair-sum
;       (filter prime-sum?
;               (flatmap
;                 (lambda (i)
;                   (map (lambda (j) (list i j))
;                        (enumerate-interval 1 (- i 1))))
;                 (enumerate-interval 1 n)))))


(define (enumerate-interval low high)
  (if (> low high)
    nil
    (cons low (enumerate-interval (+ low 1) high))))


(define (unique-pairs n)
  (flatmap
    (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))))

 
;; main
(define (main args)
  (display "この問題は今までのprime-sum-pairsの一部を切り取れば余裕")(newline)
  (display "良く分からない時は分割して考える")(newline)(newline)

  (display "まずは、enumerate-intervalの動き")(newline)
  (display "(enumerate-interval 1 5): ")
  (display (enumerate-interval 1 5))
  (newline)(newline)


  (display "次は、prime-sum-pairesの最も内側")(newline)
  (display "(map (lambda (j) (list 5 j)) (enumerate-interval 1 4)):")
  (newline)
  (display (map (lambda (j) (list 5 j)) (enumerate-interval 1 4)))
  (newline)(newline)


  (display "以下は、prime-sum-pairesの上のものの外側")(newline)
  (display "(map (lambda (i)
         (map (lambda (j) (list i j))
              (enumerate-interval 1 (- i 1))))
       (enumerate-interval 1 5)): ")
  (newline)
  (display (map (lambda (i)
         (map (lambda (j) (list i j))
              (enumerate-interval 1 (- i 1))))
       (enumerate-interval 1 5)))
  (newline)
  (newline)


  (display "上の出力だと、1の時のリスト、2の時のりすと、3の時のリスト...毎にリストになっているので")(newline)
  (display "flatmapで平らにするして名前をつけてやる。")(newline)
  (display "(unique-pairs 5): ")
  (display (unique-pairs 5))
 (newline)
  (newline)


  (display "そもそも、prime-sum-pairsの中身からとったので、対応する箇所に割り当てる。")(newline)
  (display "(prime-sum-pairs 5): ")
  (display (prime-sum-pairs 5))
  (newline)

  0)

実行

この問題は今までのprime-sum-pairsの一部を切り取れば余裕
良く分からない時は分割して考える

まずは、enumerate-intervalの動き
(enumerate-interval 1 5): (1 2 3 4 5)

次は、prime-sum-pairesの最も内側
(map (lambda (j) (list 5 j)) (enumerate-interval 1 4)):
((5 1) (5 2) (5 3) (5 4))

以下は、prime-sum-pairesの上のものの外側
(map (lambda (i)
         (map (lambda (j) (list i j))
              (enumerate-interval 1 (- i 1))))
       (enumerate-interval 1 5)): 
(() ((2 1)) ((3 1) (3 2)) ((4 1) (4 2) (4 3)) ((5 1) (5 2) (5 3) (5 4)))

上の出力だと、1の時のリスト、2の時のりすと、3の時のリスト...毎にリストになっているので
flatmapで平らにするして名前をつけてやる。
(unique-pairs 5): ((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))

そもそも、prime-sum-pairsの中身からとったので、対応する箇所に割り当てる。
(prime-sum-pairs 5): ((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7))

がんばっていたなぁ。