問題2-40〜41

写像の入れ子に関する問題です。accumulateの入れ子を利用して、より高度な問題を解いていきます。
まずは、渡された引数よりも小さな数の対を全て洗い出す処理を書きます。flatmapを利用することで、mapした結果をリスト化することができ、これにより、入れ子処理の結果を表現することができます。

(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))

(define (enumerate-interval low high)
  (if (> low high)
      '()
      (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)))

(unique-pairs 5)

=>((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))

このunique-pairsによって出来たリストのそれぞれの要素の和を素数判定ロジックでフィルタリングします。

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

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

(prime-sum-pairs 5)

=>((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7))

次は、三つの数のコンビネーションを生成するロジックを書きます。要素が重複していたらフィルタで取り除きます。

(define (same-elements conv)
  (or (= (car conv) 
         (cadr conv))
      (= (cadr conv)
         (cadr (cdr conv)))
      (= (cadr (cdr conv))
         (car conv))))

(define (unique-convs n)
  (filter (lambda (conv)
            (not (same-elements conv)))
          (flatmap (lambda (i)
                     (flatmap (lambda (j)
                                (map (lambda (k)
                                       (list i j k))
                                     (enumerate-interval 1 n)))
                              (enumerate-interval 1 n)))
                   (enumerate-interval 1 n))))      

(unique-convs 4)

=>((1 2 3)
   (1 2 4)
   (1 3 2)
   (1 3 4)
   (1 4 2)
   (1 4 3)
   (2 1 3)
   (2 1 4)
   (2 3 1)
   (2 3 4)
   (2 4 1)
   (2 4 3)
   (3 1 2)
   (3 1 4)
   (3 2 1)
   (3 2 4)
   (3 4 1)
   (3 4 2)
   (4 1 2)
   (4 1 3)
   (4 2 1)
   (4 2 3)
   (4 3 1)
   (4 3 2))

このunique-convsで生成された組み合わせの和が任意の数に等しいものを抽出する手続きを書きます。

(define (search-sum-convs n sum)
  (filter (lambda (conv)
            (= sum
               (+ (car conv)
                  (cadr conv)
                  (cadr (cdr conv)))))
          (unique-convs n)))

(search-sum-convs 4 6)

=>((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

この次の問題である｢エイトクィーンパズル｣は、ちょっと考えてみましたが、なかなか手に負えそうになかったので、時間があったら取り組んでみたいと思います。