(sicp35)m3.12~3.19

他の人って図の所はどうやって書いているんだろう？

(define orig-pair (cons '() '()))
(define (get-new-pair) orig-pair)
;;get-new-pairはlispの実装に必要らしい。
(define (my-cons x y)
  (let ((new (get-new-pair)))
    (set-car! new x)
    (set-cdr! new y)
    new))
(my-cons 3 4)

(define (my-append x y)
  (fold-right (lambda (x rest) (cons x rest)) y x))

(define (my-append! x y)
  (set-cdr! (my-last-pair x) y) x)

(define (my-last-pair seq)
  (let ((rest (cdr seq)))
  (if (null? rest)
      seq
      (my-last-pair rest))))

(define x (list 'a 'b))
(define y (list 'c 'd))

(define (report x y f)
  (let ((z (f x y)))
    (print "z= " z ": (cdr x)= " (cdr x))))

;;m3.12
(for-each (cut report x y <>)
          (list my-append my-append!))
;; 40:user> z= (a b c d): (cdr x)= (b)
;; z= (a b c d): (cdr x)= (b c d)

;;m3.13
(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)


(define z (make-cycle (list 'a 'b 'c)))
	;;listで作っているのは、quoteで作ったリストは変更しない慣習だから？
	;;(equal? (list 'a 'b) '(a b)) ;;=> #t
	;;(equal? '((lambda ())) (list (lambda ()))) ;;=>#f
		;;関数になると挙動が少し変わってくる。

;(last-pair z) ;;どう考えても無限ループ（循環参照といものだと思う。）
;; a->b->c|
;; ^------  ;;こんな感じ

;;m3.14
(define (mystery x)
  (define (loop x y)
    (if (null? x)
        y
        (let ((temp (cdr x)))
          (set-cdr! x y)
          (loop temp x))))
  (loop x '()))

(let*((v (list 'a 'b 'c 'd))
     (w (mystery v)))
  (print "v : " v "w : " w))
	;;16:user> v : (a)w : (d c b a)
;;ポインタ図は書けないな-

;;m3.15
(define (set-to-wow! x)
  (set-car! (car x) 'wow) 
x)
(define x (list 'a 'b))
(define z1 (cons x x))
(define z2 (cons (list 'a 'b) (list 'a 'b)))

(for-each (lambda (x) (print (set-to-wow! x))) (list z1 z2))
;; 35:user> ((wow b) wow b)
;; ((wow b) a b)
	;;図は面倒なので省略。z1の方はxで値を共有しているから、set-car!で変更したとき、
	;;cdrの要素も変わった。

;;m3.16
(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
         (count-pairs (cdr x))
  1)))
(define a (cons 1 2))

;;3を返すのは
(define ret3 (list 1 2 3))
(count-pairs ret3)
	;; 1:user> => 3
;;4を返すのは
(define ret4
  (let ((lst (list 1 2 3)))
    (set-car! lst (last-pair lst))
    lst))
(count-pairs ret4)
	;; 3:user> => 4

;;7を返すのは
(define ret7
  (let ((lst (list 1 2 3)))
  (set-car! lst (cdr lst))
  (set-car! (cdr lst) (last-pair lst))
  lst))
(count-pairs ret7)
	;; 5:user> => 7
    
;;何も返さないって無限ループのこと？
(define no-ret
  (let ((lst (list 1 2 3)))
    (set-cdr! (last-pair lst) lst)
    lst))
;;(count-pairs no-ret)		;;無限ループ

;;m3.17
(define (my-count-pairs x)
  (let ((counted '()))
    (define (counted? item)
      (memq item counted))
    (define (loop x)
    (if (not (pair? x))
        0
        (let ((item (car x)))
        (if (counted? item)
            0
            (begin (set! counted (cons item counted))
                   (+ (loop item)
                      (loop (cdr x))
                      1))))))
    (loop x)))
(define rets (list ret3 ret4 ret7 no-ret))
(map my-count-pairs rets)
	;;22:user> => (3 3 3 3)

;;m3.18
(define (cycle? seq)
  (let ((memory '()))
  (define (loop x)
    (cond ((not (pair? x)) #f)
          ((memq x memory) #t)
          (else
           (set! memory (cons x memory))
           (or (cycle? (car x))
               (loop (cdr x))))))
  (loop seq)))
  

(map cycle? rets) ;;35:user> => (#f #f #f #t)

;;m3.19
;;多分こういうこと?
(define (cycle?2 seq)
    (define (loop x life)
      (cond ((not (pair? x)) #f)
            ((= 0 life) #t)
            (else
             (or (cycle?2 (car x))
                 (loop (cdr x) (- life 1))))))
    (loop seq 10000))
(map cycle?2 rets)	;; 11:user> => (#f #f #f #t)