計算機プログラムの構造と解釈 第二版 P93 問題2.64

問題はaとbの二つ。

分かんない手続き名が出てきたので調べる
quotientは商を求める事が出来ます。

a
の答えの動作としては例として、(list 1 3 5 7 9 11)の場合をかきます。

partial-treeにかける。
lengthは6なので、left-sizeが2になる。
で、left-resultのpartial-treeにひっかかって
次の場合はleft-sizeは0になる。
なので、*1 が返る。
right-sizeは1になって(1 () (3 () ())) が左部分木。
this-entryは5、
partial-treeに(7 9 11)を入れると結果は (9 (7 () ()) (11 () ()))
んで、最終変形
(5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))

難しいな。何書いてあるんだ、、、
木は、上のリストから結構簡単に想像できると思うので省略

b.
対象範囲を半分ずつにしぼって変形していくから、
一瞬θ(log n)とかかとおもったんだけど、よくよく考えると、
結局左から一個ずつ作業していってる感じなのでθ(n)では無いでしょうか？？

実装

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

(use ggc.debug.trace)
(use math.mt-random)


(define nil '())

(define (entry tree) (car tree))

(define (left-branch tree) (cadr tree))

(define (right-branch tree) (caddr tree))

(define (make-tree entry left right)
  (list entry left right))


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


(define (adjoin-set x set)
  (cond ((null? set) (make-tree x nil nil))
        ((= 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))))))


;;P91 図2.16の木を表したもの左からtree1、tree2、tree3
(define tree1 (make-tree 7 
                         (make-tree 3 
                                    (make-tree 1 nil nil)
                                    (make-tree 5 nil nil))
                         (make-tree 9
                                    nil
                                    (make-tree 11 nil nil))))

(define tree2 (make-tree 3
                         (make-tree 1 nil nil)
                         (make-tree 7
                                    (make-tree 5 nil nil)
                                    (make-tree 9
                                               nil
                                               (make-tree 11 nil nil)))))

(define tree3 (make-tree 5
                         (make-tree 3
                                    (make-tree 1 nil nil)
                                    nil)
                         (make-tree 9
                                    (make-tree 7 nil nil)
                                    (make-tree 11 nil nil))))

;;P92図2.17の木を表した物を、tree4とする。
(define tree4 (make-tree 1
                         nil
                         (make-tree 2
                                    nil
                                    (make-tree 3
                                               nil
                                               (make-tree 4
                                                          nil
                                                          (make-tree 5
                                                                     nil
                                                                     (make-tree 6
                                                                                nil
                                                                                (make-tree 7 nil nil))))))))

;;問題2.63
(define (tree->list-1 tree)
  (if (null? tree) nil
    (append (tree->list-1 (left-branch tree))
            (cons (entry tree)
                  (tree->list-1 (right-branch tree))))))


(define (tree->list-2 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 nil))

;;問題2.64
(define (list->tree elements)
  (car (partial-tree elements (length elements))))

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


;; main
(define (main args)

  (display "(list->tree '(1 3 5 7 9 11)): ")
  (display (list->tree '(1 3 5 7 9 11)))
  (newline)

  0)

実行

(list->tree '(1 3 5 7 9 11)): (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))

この手続き作った人すげぇなぁ。。。

*1:) . (1 3 5 7 9 11