汎用演算 新しい型を追加するとき すべての汎用選択子の定義を変更する必要あり 名前などがかぶらないように注意しないといけない。 新しい演算を追加するとき ふつうに新しく書くだけ。 データ主導 新しい型を追加するとき 内部手続きとして名前を気にせず…

;; なんか普通のオブジェクト指向っぽい感じだ。 (define (make-from-mag-arg r a) (define (dispatch op) (cond ((eq? op 'real-part) (* r (cos a))) ((eq? op 'imag-pert) (* r (sin a))) ((eq? op 'magnitude) r) ((eq? op 'angle) a) (else (error "Unk…

;; a ;; それぞれの事業所のファイルには個別の型がついている。 ;; placeという手続きによって型名を呼び出せる。 (define (get-record file name) ((get 'get-record (place file)) (records file) name)) (define (place obj) (car obj)) (define (record…

スキップします。あとで

スキップします。あとで

;;n = 5 '(1 2 4 8 16) 31--15--7--3--1 | | | |-2 | | |-4 | |-8 |-16 ;;n = 10 '(1 2 4 8 16 32 64 128 256 512) 1023--511--255--127--63--31--15--7--3--1 | | | | | | | | +-2 | | | | | | | +-4 | | | | | | +-8 | | | | | +-16 | | | | +-32 | | | +-…

(define rock-1950-tree (generate-huffman-tree '((A 2) (NA 16) (BOOM 1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1)))) (define song '( GET A JOB SHA NA NA NA NA NA NA NA NA GET A JOB SHA NA NA NA NA NA NA NA NA WAH YIP YIP YIP YIP YIP YIP YIP Y…

(define (generate-huffman-tree pairs) (successive-merge (make-leaf-set pairs))) (define (successive-merge leaf-set) (if (> (length leaf-set) 1) (successive-merge (adjoin-set (make-code-tree (car leaf-set) (cadr leaf-set)) (cddr leaf-set)))…

(define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) ;; rec (define (encode-symbol message tree) (if (leaf? tree) '() (if (memq message (symbols (left-branch tree))…

define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? object) (eq? (car object) 'leaf)) (define (symbol-leaf x) (cadr x)) (define (weight-leaf x) (caddr x)) (define (make-code-tree left right) (list left right (append…

(define (lookup given-key set-of-records) (if (null? set-of-records) #f (let ((record (entry set-of-records))) (cond ((= given-key (key record)) record) ((< given-key (key record)) (lookup given-key (left-branch set-of-records))) ((> given…

(define (union-tree tree1 tree2) (let ((list1 (tree->list-2 tree1)) (list2 (tree->list-2 tree2))) (list->tree (union-set list1 list2)))) (define (intersection-tree tree1 tree2) (let ((list1 (tree->list-2 tree1)) (list2 (tree->list-2 tree2)…

(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))) (let ((left-result (partial-tree elts left-size))) (let ((left…

SICP超久しぶり。 思えば学部2-3年のころに一生懸命やっていたな。 ranobaの開発に移ってから、ずっとほったらかしにしていた。 やっぱり難しい。あまり成長してないのか。。。。 なんにしろ、いい加減に終わらせないとね。ぱっぱと飛ばしてこう。 (define (…