(sicp25)m2.64〜2.66

(use pre-sicp)

;; 2分木を使った集合を扱うデータ構造の復習をする。
;; 見ないで書いてみる。

(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))

(define (make-tree symbol l r)
  (list symbol l r))

(define (element-of-set? x set)
  (let ((e (entry set)))
    (cond ((null? set) #f)
          ((= x e) #t)
        ((< x e)
         (element-of-set? x (left-branch set)))
        ((> x e)
         (element-of-set? x (right-branch set))))))


(define (adjoin-set x set)
  (cond ((null? set) (make-tree x '() '()))
        ((= x (entry set) set))
        ((< x (entry set))
         (make-tree (entry set)
                    (adjoin-set x (left-branch set))
                    (right-branch set)))
        ((> x (entry set))
         (make-tree (entry set)
                    (left-branch set)
                    (adjoin-set x (right-branch set))))))

;; 復習終了。見ないでもなんとか書けた。
;; 教科書を写す。

(define (tree->list1 tree)
  (if (null? tree)
      '()
      (append (tree->list1 (left-branch tree))
              (cons (entry tree)
                    (tree->list1 (right-branch tree))))))

(define (tree->list2 tree)
  (define (copy-to-list tree result-list)
    (if (null? tree)
        result-list
        (copy-to-list (left-branch tree)
                      (cons (entry tree)
                            (copy-to-list (right-branch tree)
                                          result-list)))))
  (copy-to-list tree '()))

(let ((no-leaf (lambda (x) (make-tree x '() '())))
      (a adjoin-set))
  (tree->list2 (a 4 (a 7 (a 5 (no-leaf 3))))))
;; gosh> (3 4 5 7)

(define (list->tree elements)
  (car (partial-tree elements (length elements))))

(define (partial-tree elts n)
  (if (= n 0)
      (cons '() elts)
      (let* ((left-size (quotient (- n 1) 2))
             (left-result (partial-tree elts left-size))
             (left-tree (car left-result))
             (non-left-elts (cdr left-result))
             (right-size (- n (+ left-size 1)))
             (this-entry (car non-left-elts))
             (right-result (partial-tree (cdr non-left-elts)
                                         right-size))
             (right-tree (car right-result))
             (remaining-elts (cdr right-result)))
        (cons (make-tree this-entry left-tree right-tree)
              remaining-elts))))

;;a
(list->tree (filter even? (enumerate-interval 1 12)))
;;木の要素を左の木とそれ以外に分ける
;; left-result
;; =[left-tree non-left-elts]
;; =[left-tree [this-entry right-result]]
;; =[left-tree [this-entry [right-tree remaining-elts]]]
;; この様な構造のものを再帰させて（最後必ず'()を返すようにする）
;; (実際のところ*-resultはpartical-treeの再帰式)
;; (（木の要素）(左の木を作る再帰)（右の木を作る再帰))

;; （2分木について(n=1+ls+rs）
;; n=要素数。ls=左の葉の数。
;; (if (odd? n)
;;     '(('even ls) ('even rs))
;;     (or '(('odd ls) ('even rs))
;;         '(('even ls) ('odd rs)))) ;;今回の場合はこっち


;; 出力されるのはこんな感じ
;;   |--6--|
;; |-2   |-10-|
;; 4     8    12

;;b
;; O(n)


;;ちょっと寄り道（treeの内容を表示する（リスト形式））

(define (display-tree->list tree)
  (print (tree->list2 tree)))

(define (display-tree->list2 tree)
  (cond ((null? tree) '())
        ((null? (left-branch tree))
         (cond ((null? (right-branch tree))
                (display (entry tree)))
               (else
                (display (entry tree))
                (display-tree->list2 (right-branch tree)))))
         ((null? (right-branch tree))
          (display-tree->list2 (left-branch tree))
          (display (entry tree)))
         (else
          (display-tree->list2 (left-branch tree))
          (display (entry tree))
          (display-tree->list2 (right-branch tree)))))

(let ((target (car (partial-tree (enumerate-interval 1 5) 5))))
  (display-tree->list target)
  (display-tree->list2 target))
;; gosh> (1 2 3 4 5)
;; 12345#<undef>

;; display-tree->list2はけっこう長い。木をまじめに走査していくと面倒。
;; それに対して、display-treeはとても簡単。
;; どのような処理行われているのか分からなくても,tree->listが
;; 存在することを知っていればdisplay-tree->listは簡単に作れる.
;; 成層構造？（だったかな？）ってすごい！！！

;;m.2.65

;;リストを経由すれば簡単。
;;リストからの(intersection/union)-setはO(n)って説明されているし…

(define (union-set set1 set2)
  (list->tree (union-list (tree->list2 set1)
                          (tree->list2 set2))))

(define (intersection-set set1 set2)
  (list->tree (intersection-list (tree->list2 set1)
                                (tree->list2 set2))))

(define (union-list seq1 seq2)
  (cond ((null? seq1) seq2)
        ((null? seq2) seq1)
        (else
         (let ((e1 (car seq1)) (e2 (car seq2)))
           (cond
            ((= e1 e2)
             (cons e1 (union-list (cdr seq1) (cdr seq2))))
            ((< e1 e2)
             (cons e1 (union-list (cdr seq1) seq2)))
            ((> e1 e2)
             (cons e2 (union-list seq1 (cdr seq2)))))))))

(define (intersection-list seq1 seq2)
  (cond ((null? seq1) '())
        ((null? seq2) '())
        (else
         (let ((e1 (car seq1)) (e2 (car seq2)))
           (cond
            ((= e1 e2)
             (cons e1 (intersection-list (cdr seq1) (cdr seq2))))
            ((< e1 e2)
             (intersection-list (cdr seq1) seq2))
            ((> e1 e2)
             (intersection-list seq1 (cdr seq2))))))))

(let ((t1 (enumerate-interval 1 5))
      (t2 (filter odd? (enumerate-interval 1 10))))
  (print (union-list t1 t2))
  (print (intersection-list t1 t2))
  (print (union-set (list->tree t1)
                    (list->tree t2)))
  (print (intersection-set (list->tree t1)
                           (list->tree t2))))
;; gosh> (1 2 3 4 5 7 9)
;; (1 3 5)
;; (4 (2 (1 () ()) (3 () ())) (7 (5 () ()) (9 () ())))
;; (3 (1 () ()) (5 () ()))

;; しっかり動いている。



(define (lookup given-key set-of-records)
  (cond ((null? set-of-records) #f)
        ((equal? given-key (key (car set-of-records)))
                 (car set-of-records))
        (else (lookup given-key (cdr set-of-records)))))

;;m2.66
(define (lookup2 given-key set-of-records)
  (cond ((null? set-of-records) #f)
        (let ((item (entry set-of-records)))
          (cond ((= given-key item) #t)
                ((< given-key item)
                 (lookup2 given-key (left-branch set-of-records)))
                ((> given-key item)
                 (lookup2 given-key (right-branch set-of-records)))))))