(sicp20) 2章の最初から問題2．42まで（所々飛ばしながら）

再開してからコードを書くスピードが遅くなってしまった気がしたので、
以前の感覚を取り戻すために2章の問題を初めからしてみた。

(use pre-sicp)

;;display -> null-display
;;print   -> null-print
;;(define (null-display x))
;;(define (null-print x . y))
;;そこまで便利じゃなかった。

;;m2.1
(define (make-rat n d) (cons n d))
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
  (print (numer x) "/" (denom x)))

(print-rat (make-rat 1 2))
;; 	gosh> 1/2

(define (make-rat n d)
  (if (>= (* n d) 0)
      (cons (abs n) (abs d))
      (cons (- 0 (abs n)) (abs d))))
(define (f x y)
  (print-rat (make-rat x y)))
(f 1 2)
;; 	gosh> 1/2
(f 1 -2)
;; 	gosh> -1/2
(f -1 2)
;; 	gosh> -1/2
(f -1 -2)
;; 	gosh> 1/2

;;m2.4
(define (mycons x y)
  (lambda (m) (m x y)))
(define (mycar z)
  (z (lambda (p q) p)))
(define (mycdr z)
  (z (lambda (p q) q)))

;;m2.5
;;後で

;;m2.6
(define zero (lambda (f) (lambda (x) x)))
(define (add-1 (lambda (f) (lambda (x) (f ((n f) x))))))
(define one (lambda (f) (lambda (x) (f x))))
(define two (lambda (f) (lambda (x) (f (f x)))))
(define (add n1 n2) (lambda (f) (lambda (x) ((n2 f)((n1 f) x)))))
(define (inc x) (+ x 1))

((two inc) 3)
;; 	gosh> 5
(((add one two) inc) 3)
;; 	gosh> 6


;;m2.17
(define (last-pair seq)
  (if (null? (cdr seq))
      seq
      (last-pair (cdr seq))))

(last-pair (enumerate-interval 1 10))
;; 	gosh> (10)

;;m2.18
(define (reverse seq)
  (if (null? (cdr seq))
      (list (car seq))
      (append (reverse (cdr seq))(list (car seq)))))

(reverse (enumerate-interval 1 5))
;; 	gosh> (5 4 3 2 1)


;;m2.20
(define (same-parity x . ys)
  (let ((which? (if (odd? x) odd? even?)))
    (append (list x) (filter which? ys))))
(same-parity 1 2 3 4 5 6 6)
;; 	gosh> (1 3 5)

;;m2.21
(define (square-list items)
  (if (null? items)
      '()
      (cons ((lambda (x) (* x x)) (car items))
            (square-list (cdr items)))))
(square-list (enumerate-interval 1 10))
;; 	gosh> (1 4 9 16 25 36 49 64 81 100)

;;use map
(define (square-list2 items)
  (map (lambda (x) (* x x)) items))
(square-list2 (enumerate-interval 1 4))

;;m2.23
(define (myfor-each f seq)
  (cond ((null? seq) #t)
        (else (f (car seq))
              (for-each f (cdr seq)))))
(myfor-each (lambda (x) (newline) (display x)) '(57 321 88))
;; 	gosh> 
;; 57
;; 321
;; 88#<undef>


;;m2.26
(let ((x (list 1 2 3))
      (y (list 4 5 6)))
      (print (append x y))
      (print (cons x y))
      (print (list x y)))
;; 	gosh> (1 2 3 4 5 6)
;; ((1 2 3) 4 5 6)
;; ((1 2 3) (4 5 6))



;;m2.27 ;;m2.28
(let ((x (list (list 1 2) (list 3 4))))
  (define (deep-reverse tree)
    (if (pair? tree)
        (reverse (map deep-reverse tree))
        tree))
  (define (fringe tree)
    (cond ((null? tree) '())
          ((not (pair? tree))(list tree))
          (else
           (append (fringe (car tree)) (fringe (cdr tree))))))
(print (deep-reverse x)) ;;deep-reverse
(print (fringe x)))

;; 	gosh> ((4 3) (2 1))
;; (1 2 3 4)


;;m2.30 m2.31
(let* ((target '(1 (2 (3 4) 5) (6 7)))
      (square (lambda (x) (* x x)))
      (reply (lambda (f) (print (f target)))))
  (define (square-tree tree)
    (if (null? tree)
        '()
        (if (not (pair? tree))
            (square tree)
            (cons (square-tree (car tree))
                  (square-tree (cdr tree))))))
  (define (map-square-tree tree)
    (map (lambda (x)
           (if (pair? x)
               (map-square-tree x)
               (square x)))
         tree))
  (define (tree-map  f tree)
    (map (lambda (sub-tree)
           (if (pair? sub-tree)
               (tree-map f sub-tree)
               (f sub-tree)))
         tree))
  (print "original")
  (print target)
  (print "==answer==")
  (reply square-tree)
  (reply map-square-tree)
  (reply (lambda (x) (tree-map square x))))

;; 	gosh> original
;; (1 (2 (3 4) 5) (6 7))
;; ==answer==
;; (1 (4 (9 16) 25) (36 49))
;; (1 (4 (9 16) 25) (36 49))
;; (1 (4 (9 16) 25) (36 49))
;;I got it(how to use "let*")!

;;m2.32
(define (subsets s)
  (if (null? s)
      (list '())
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (x) (cons (car s) x)) rest)))))

(print (subsets '(1 2 3)))
;; 	gosh> (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))


;;m2.33
;;f = function
;;p = procedure
(let* ((cube (lambda (x) (* x x x)))
      (target (enumerate-interval 1 5))
      (reply (lambda (f g) (print (f g target)))))
  (define (my-map p sequence)
    (accumulate (lambda (x y) (cons (p x) y)) '() sequence))
  (define (my-append seq1 seq2)
    (accumulate cons seq2 seq1))
  (define (my-length sequence)
    (accumulate (lambda (x y) (+ y 1)) 0 sequence))
  (reply my-map cube)
  (reply my-append '(10 100 1000))
  (print (my-length target)))

;; 	gosh> (1 8 27 64 125)
;; (10 100 1000 1 2 3 4 5)
;; 5

;;m2.34
(define (horner-eval x cofficient-seqence)
  (accumulate (lambda (this-coeff higher-terms)
                (+ this-coeff (* higher-terms x)))
                0
              cofficient-seqence))

(horner-eval 2 (list 1 3 0 5 0 1))
;; 	gosh> 79


;;m2.35
(let ((target '(1 (2 (3 4) 5)((4 5)) (6 7))))
  (define (count-leaves x) ;;教科書の
    (cond ((null? x) 0)
          ((not (pair? x)) 1)
          (else (+ (count-leaves (car x))
                   (count-leaves (cdr x))))))
  (define (acc-count-leaves tree)
    (accumulate (lambda (x y)
                  (+ y (if (not (pair? x)) 1 (acc-count-leaves  x))))
                0 tree))
  (= (acc-count-leaves target)
     (count-leaves target)))
;; 	gosh> #t
                               

;;m2.36
(let ((target '((1 2 3) (4 5 6) (7 8 9) (10 11 12))))
  (define (accumulate-n op init seqs)
    (if (null? (car seqs))
        '()
        (cons (accumulate op init (map car seqs))
              (accumulate-n op init (map cdr seqs)))))
  (accumulate-n + 0 target))

;; 	gosh> (22 26 30)

;;m2.37
(define (dot-product v w)
  (accumulate + 0 (map * v w)))

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

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

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

(dot-product '(1 2) '(10 100))
;; 	gosh> 210
(transpose '((1 2) (3 4)))
;; 	gosh> ((1 3) (2 4))
(matrix-*-vector '((1 2 3) (4 5 6)) '(10 100 100))
;; 	gosh> (510 1140)
(matrix-*-matrix '((1 0) (0 1)) '((1 0) (0 1)))
;; 	gosh> ((1 0) (0 1))

;;m2.39
(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 (fold-right op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (fold-right op initial (cdr sequence)))))

(fold-right / 1 (list 1 2 3))
;;	 gosh> 3/2
(fold-left  / 1 (list 1 2 3))
;;	 gosh> 1/6

(let ((target (enumerate-interval 1 10)))
  (define (r-reverse sequence)
    (fold-right (lambda (x y) (append y (list x))) '() sequence))
  (define (l-reverse sequence)
    (fold-left (lambda (x y) (cons y x)) '() sequence))
  (if (equal? (r-reverse target) (l-reverse target))
      (l-reverse target)))
;;	 gosh> (10 9 8 7 6 5 4 3 2 1)


;;m.2.40
(define (unique-pairs n)
  (flatmap (lambda (i)
             (map (lambda (j)
                    (list i j))
                  (enumerate-interval i (- n 1))))
             (enumerate-interval 1 n)))

(unique-pairs 5)
;; 	gosh> ((1 1) (1 2) (1 3) (1 4) (2 2) (2 3) (2 4) (3 3) (3 4) (4 4))

(define (sum seq)  (accumulate + 0 seq))

;;素数か調べるprime?は定義済み
(define (prime-sum-pairs n)
  (filter (lambda (xs) (prime? (sum xs)))
          (unique-pairs n)))

(prime-sum-pairs 6)
;; 	gosh> ((1 2) (1 4) (2 3) (2 5) (3 4))

;;m2.41
;;i<=j<=k<=n
;;
(define (3sum-is-s n s)
  (filter (lambda (xs) (= s (sum xs)))
          (flatmap (lambda (x)
                     (map (lambda (y) (append (list x) y)) (unique-pairs x)))
                   (enumerate-interval 1 n))))
(3sum-is-s 20 11)
;; gosh> ((5 2 4) (5 3 3) (6 1 4) (6 2 3) (7 1 3) (7 2 2) (8 1 2) (9 1 1))

追記

最後の順序づけられてなかった。効率悪いけどこれでいいや

(define (new-3sum-is-s n s)
  (map sort　(3sum-is-s n s)))
(new-3sum-is-s 20 11)
;; gosh> ((2 4 5) (3 3 5) (1 4 6) (2 3 6) (1 3 7) (2 2 7) (1 2 8) (1 1 9))