Hatena::Groupcsnagoya-sicp

クラなんとかの日記 このページをアンテナに追加 RSSフィード

 | 

2009-06-16掃除中

2.40

| 2.40 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.40 - クラなんとかの日記 2.40 - クラなんとかの日記 のブックマークコメント

1 <= j < i <= n なる unique-pairs を定義せよ.という問題.

ついでに,prime-sum-pairs もそれを使って書き直せともある.

元のprime-sum-pairs の部分を取ってくればよい.

下記回答だと,unique-pairs の出力がx, y でソートされるようにしてある.

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

;; 準備
(define nil (list))

;; 2.2.3 より (日本語版 p.28)
(define (square x) (* x x))

(define (smallest-divisor n)
  (find-divisor n 2))

(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))

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

(define (prime? n)
  (= n (smallest-divisor n)))

;; 2.2.3 より (日本語版 p.66)
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

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

;; 2.2.3 より (日本語版 p.67)
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

;; 2.2.3 より (日本語版 p.71)
(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 (unique-pairs n)
  (flatmap (lambda (j)
             (map (lambda (i)
                    (list i j))
                  (enumerate-interval 1 (- j 1))))
           (enumerate-interval 2 n)))

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

;; 確認
(define n 5)

(display n) (newline) ; 5
(display (unique-pairs n)) (newline) ; ((1 2) (1 3) (2 3) (1 4) (2 4) (3 4) (1 5) (2 5) (3 5) (4 5))
(display (prime-sum-pairs n)) (newline) ; ((1 2 3) (2 3 5) (1 4 5) (3 4 7) (2 5 7))

2.39

| 2.39 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.39 - クラなんとかの日記 2.39 - クラなんとかの日記 のブックマークコメント

reverse を fold-{right, left} を使って書け.という問題

fold-right が再帰.fold-left が反復ということがわかればいい感じかな?

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

;; 準備
(define nil (list))

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

(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))

;; 答え
(define (reverse-r sequence)
  (fold-right (lambda (x y) (append y (list x))) nil sequence))

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

;; 確認
(define x (list 1 2 3))

(display x) (newline) ; (1 2 3)
(display (reverse-r x)) (newline) ; (3 2 1)
(display (reverse-l x)) (newline) ; (3 2 1)
 |