Compare commits
No commits in common. "b326460d60f9cc5e839cde9fa195636b850b74b7" and "6fb03cda1c299ee674daff468cd1c06d369d369c" have entirely different histories.
b326460d60
...
6fb03cda1c
10 changed files with 0 additions and 540 deletions
|
|
@ -1,67 +0,0 @@
|
||||||
#lang sicp
|
|
||||||
|
|
||||||
(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 (symbols left) (symbols right))
|
|
||||||
(+ (weight left) (weight right))))
|
|
||||||
|
|
||||||
(define (left-branch tree) (car tree))
|
|
||||||
(define (right-branch tree) (cadr tree))
|
|
||||||
(define (symbols tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(list (symbol-leaf tree))
|
|
||||||
(caddr tree)))
|
|
||||||
(define (weight tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(weight-leaf tree)
|
|
||||||
(cadddr tree)))
|
|
||||||
|
|
||||||
(define (decode bits tree)
|
|
||||||
(define (decode-1 bits current-branch)
|
|
||||||
(if (null? bits)
|
|
||||||
'()
|
|
||||||
(let ((next-branch
|
|
||||||
(choose-branch (car bits) current-branch)))
|
|
||||||
(if (leaf? next-branch)
|
|
||||||
(cons (symbol-leaf next-branch)
|
|
||||||
(decode-1 (cdr bits) tree))
|
|
||||||
(decode-1 (cdr bits) next-branch)))))
|
|
||||||
(decode-1 bits tree))
|
|
||||||
|
|
||||||
(define (choose-branch bit branch)
|
|
||||||
(cond ((= bit 0) (left-branch branch))
|
|
||||||
((= bit 1) (right-branch branch))
|
|
||||||
(else (error "bad bit: CHOOSE-BRANCH" bit))))
|
|
||||||
|
|
||||||
(define (adjoin-set x set)
|
|
||||||
(cond ((null? set) (list x))
|
|
||||||
((< (weight x) (weight (car set))) (cons x set))
|
|
||||||
(else (cons (car set)
|
|
||||||
(adjoin-set x (cdr set))))))
|
|
||||||
|
|
||||||
(define (make-leaf-set pairs)
|
|
||||||
(if (null? pairs)
|
|
||||||
'()
|
|
||||||
(let ((pair (car pairs)))
|
|
||||||
(adjoin-set (make-leaf (car pair) ; symbol
|
|
||||||
(cadr pair)) ; frequency
|
|
||||||
(make-leaf-set (cdr pairs))))))
|
|
||||||
|
|
||||||
(define sample-tree
|
|
||||||
(make-code-tree (make-leaf 'A 4)
|
|
||||||
(make-code-tree
|
|
||||||
(make-leaf 'B 2)
|
|
||||||
(make-code-tree
|
|
||||||
(make-leaf 'D 1)
|
|
||||||
(make-leaf 'C 1)))))
|
|
||||||
|
|
||||||
(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
|
|
||||||
|
|
||||||
; (decode sample-message sample-tree)
|
|
||||||
; (A D A B B C A)
|
|
||||||
|
|
@ -1,99 +0,0 @@
|
||||||
#lang sicp
|
|
||||||
|
|
||||||
(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 (symbols left) (symbols right))
|
|
||||||
(+ (weight left) (weight right))))
|
|
||||||
|
|
||||||
(define (left-branch tree) (car tree))
|
|
||||||
(define (right-branch tree) (cadr tree))
|
|
||||||
(define (symbols tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(list (symbol-leaf tree))
|
|
||||||
(caddr tree)))
|
|
||||||
(define (weight tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(weight-leaf tree)
|
|
||||||
(cadddr tree)))
|
|
||||||
|
|
||||||
(define (decode bits tree)
|
|
||||||
(define (decode-1 bits current-branch)
|
|
||||||
(if (null? bits)
|
|
||||||
'()
|
|
||||||
(let ((next-branch
|
|
||||||
(choose-branch (car bits) current-branch)))
|
|
||||||
(if (leaf? next-branch)
|
|
||||||
(cons (symbol-leaf next-branch)
|
|
||||||
(decode-1 (cdr bits) tree))
|
|
||||||
(decode-1 (cdr bits) next-branch)))))
|
|
||||||
(decode-1 bits tree))
|
|
||||||
|
|
||||||
(define (choose-branch bit branch)
|
|
||||||
(cond ((= bit 0) (left-branch branch))
|
|
||||||
((= bit 1) (right-branch branch))
|
|
||||||
(else (error "bad bit: CHOOSE-BRANCH" bit))))
|
|
||||||
|
|
||||||
(define (adjoin-set x set)
|
|
||||||
(cond ((null? set) (list x))
|
|
||||||
((< (weight x) (weight (car set))) (cons x set))
|
|
||||||
(else (cons (car set)
|
|
||||||
(adjoin-set x (cdr set))))))
|
|
||||||
|
|
||||||
(define (make-leaf-set pairs)
|
|
||||||
(if (null? pairs)
|
|
||||||
'()
|
|
||||||
(let ((pair (car pairs)))
|
|
||||||
(adjoin-set (make-leaf (car pair) ; symbol
|
|
||||||
(cadr pair)) ; frequency
|
|
||||||
(make-leaf-set (cdr pairs))))))
|
|
||||||
|
|
||||||
(define sample-tree
|
|
||||||
(make-code-tree (make-leaf 'A 4)
|
|
||||||
(make-code-tree
|
|
||||||
(make-leaf 'B 2)
|
|
||||||
(make-code-tree
|
|
||||||
(make-leaf 'D 1)
|
|
||||||
(make-leaf 'C 1)))))
|
|
||||||
|
|
||||||
(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
|
|
||||||
|
|
||||||
; (decode sample-message sample-tree)
|
|
||||||
; (A D A B B C A)
|
|
||||||
|
|
||||||
; until now previous exercise
|
|
||||||
|
|
||||||
; setup for the current one
|
|
||||||
(define (encode message tree)
|
|
||||||
(if (null? message)
|
|
||||||
'()
|
|
||||||
(append (encode-symbol (car message) tree)
|
|
||||||
(encode (cdr message) tree))))
|
|
||||||
|
|
||||||
; my procedure
|
|
||||||
; assumes that a tree is well formed, ie. that if a symbol appears in a
|
|
||||||
; parent node's list it must be in one of the child branches
|
|
||||||
; not the most efficient since it checks symbol lists at almost every level
|
|
||||||
; twice
|
|
||||||
(define (encode-symbol symbol tree)
|
|
||||||
(cond ((not (member-set symbol (symbols tree)))
|
|
||||||
(error "encode-symbol: no seq for the symbol in tree" symbol tree))
|
|
||||||
((leaf? tree)
|
|
||||||
'())
|
|
||||||
((member-set symbol (symbols (left-branch tree)))
|
|
||||||
(cons 0 (encode-symbol symbol (left-branch tree))))
|
|
||||||
((member-set symbol (symbols (right-branch tree)))
|
|
||||||
(cons 1 (encode-symbol symbol (right-branch tree))))))
|
|
||||||
|
|
||||||
(define member-set member)
|
|
||||||
; since a set is represented as a list, we can simply use the member procedure
|
|
||||||
|
|
||||||
;test:
|
|
||||||
; input: (A D A B B C A)
|
|
||||||
; output:(0 1 1 0 0 1 0 1 0 1 1 1 0)
|
|
||||||
; it works!
|
|
||||||
|
|
@ -1,66 +0,0 @@
|
||||||
#lang sicp
|
|
||||||
|
|
||||||
(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 (symbols left) (symbols right))
|
|
||||||
(+ (weight left) (weight right))))
|
|
||||||
|
|
||||||
(define (left-branch tree) (car tree))
|
|
||||||
(define (right-branch tree) (cadr tree))
|
|
||||||
(define (symbols tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(list (symbol-leaf tree))
|
|
||||||
(caddr tree)))
|
|
||||||
(define (weight tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(weight-leaf tree)
|
|
||||||
(cadddr tree)))
|
|
||||||
|
|
||||||
(define (decode bits tree)
|
|
||||||
(define (decode-1 bits current-branch)
|
|
||||||
(if (null? bits)
|
|
||||||
'()
|
|
||||||
(let ((next-branch
|
|
||||||
(choose-branch (car bits) current-branch)))
|
|
||||||
(if (leaf? next-branch)
|
|
||||||
(cons (symbol-leaf next-branch)
|
|
||||||
(decode-1 (cdr bits) tree))
|
|
||||||
(decode-1 (cdr bits) next-branch)))))
|
|
||||||
(decode-1 bits tree))
|
|
||||||
|
|
||||||
(define (choose-branch bit branch)
|
|
||||||
(cond ((= bit 0) (left-branch branch))
|
|
||||||
((= bit 1) (right-branch branch))
|
|
||||||
(else (error "bad bit: CHOOSE-BRANCH" bit))))
|
|
||||||
|
|
||||||
(define (adjoin-set x set)
|
|
||||||
(cond ((null? set) (list x))
|
|
||||||
((< (weight x) (weight (car set))) (cons x set))
|
|
||||||
(else (cons (car set)
|
|
||||||
(adjoin-set x (cdr set))))))
|
|
||||||
|
|
||||||
(define (make-leaf-set pairs)
|
|
||||||
(if (null? pairs)
|
|
||||||
'()
|
|
||||||
(let ((pair (car pairs)))
|
|
||||||
(adjoin-set (make-leaf (car pair) ; symbol
|
|
||||||
(cadr pair)) ; frequency
|
|
||||||
(make-leaf-set (cdr pairs))))))
|
|
||||||
|
|
||||||
; actual exercise
|
|
||||||
(define (generate-huffman-tree pairs)
|
|
||||||
(successive-merge (make-leaf-set pairs)))
|
|
||||||
|
|
||||||
(define (successive-merge tree-set)
|
|
||||||
(if (null? (cdr tree-set)) ; (= (length tree-list) 1)
|
|
||||||
(car tree-set)
|
|
||||||
(let ((tree1 (car tree-set))
|
|
||||||
(tree2 (cadr tree-set)))
|
|
||||||
(successive-merge (adjoin-set (make-code-tree tree1 tree2)
|
|
||||||
(cddr tree-set))))))
|
|
||||||
|
|
@ -1,109 +0,0 @@
|
||||||
#lang sicp
|
|
||||||
|
|
||||||
(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 (symbols left) (symbols right))
|
|
||||||
(+ (weight left) (weight right))))
|
|
||||||
|
|
||||||
(define (left-branch tree) (car tree))
|
|
||||||
(define (right-branch tree) (cadr tree))
|
|
||||||
(define (symbols tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(list (symbol-leaf tree))
|
|
||||||
(caddr tree)))
|
|
||||||
(define (weight tree)
|
|
||||||
(if (leaf? tree)
|
|
||||||
(weight-leaf tree)
|
|
||||||
(cadddr tree)))
|
|
||||||
|
|
||||||
(define (decode bits tree)
|
|
||||||
(define (decode-1 bits current-branch)
|
|
||||||
(if (null? bits)
|
|
||||||
'()
|
|
||||||
(let ((next-branch
|
|
||||||
(choose-branch (car bits) current-branch)))
|
|
||||||
(if (leaf? next-branch)
|
|
||||||
(cons (symbol-leaf next-branch)
|
|
||||||
(decode-1 (cdr bits) tree))
|
|
||||||
(decode-1 (cdr bits) next-branch)))))
|
|
||||||
(decode-1 bits tree))
|
|
||||||
|
|
||||||
(define (choose-branch bit branch)
|
|
||||||
(cond ((= bit 0) (left-branch branch))
|
|
||||||
((= bit 1) (right-branch branch))
|
|
||||||
(else (error "bad bit: CHOOSE-BRANCH" bit))))
|
|
||||||
|
|
||||||
(define (adjoin-set x set)
|
|
||||||
(cond ((null? set) (list x))
|
|
||||||
((< (weight x) (weight (car set))) (cons x set))
|
|
||||||
(else (cons (car set)
|
|
||||||
(adjoin-set x (cdr set))))))
|
|
||||||
|
|
||||||
(define (make-leaf-set pairs)
|
|
||||||
(if (null? pairs)
|
|
||||||
'()
|
|
||||||
(let ((pair (car pairs)))
|
|
||||||
(adjoin-set (make-leaf (car pair) ; symbol
|
|
||||||
(cadr pair)) ; frequency
|
|
||||||
(make-leaf-set (cdr pairs))))))
|
|
||||||
|
|
||||||
(define (generate-huffman-tree pairs)
|
|
||||||
(successive-merge (make-leaf-set pairs)))
|
|
||||||
|
|
||||||
(define (successive-merge tree-set)
|
|
||||||
(if (null? (cdr tree-set)) ; (= (length tree-list) 1)
|
|
||||||
(car tree-set)
|
|
||||||
(let ((tree1 (car tree-set))
|
|
||||||
(tree2 (cadr tree-set)))
|
|
||||||
(successive-merge (adjoin-set (make-code-tree tree1 tree2)
|
|
||||||
(cddr tree-set))))))
|
|
||||||
|
|
||||||
; the encode functionality from 2.68
|
|
||||||
(define (encode message tree)
|
|
||||||
(if (null? message)
|
|
||||||
'()
|
|
||||||
(append (encode-symbol (car message) tree)
|
|
||||||
(encode (cdr message) tree))))
|
|
||||||
|
|
||||||
(define (encode-symbol symbol tree)
|
|
||||||
(cond ((not (member-set symbol (symbols tree)))
|
|
||||||
(error "encode-symbol: no seq for the symbol in tree" symbol tree))
|
|
||||||
((leaf? tree)
|
|
||||||
'())
|
|
||||||
((member-set symbol (symbols (left-branch tree)))
|
|
||||||
(cons 0 (encode-symbol symbol (left-branch tree))))
|
|
||||||
((member-set symbol (symbols (right-branch tree)))
|
|
||||||
(cons 1 (encode-symbol symbol (right-branch tree))))))
|
|
||||||
|
|
||||||
(define member-set member)
|
|
||||||
; since a set is represented as a list, we can simply use the member procedure
|
|
||||||
|
|
||||||
; actual exercise 2.70
|
|
||||||
|
|
||||||
(define sample-tree
|
|
||||||
(generate-huffman-tree '((a 2)
|
|
||||||
(get 2)
|
|
||||||
(sha 3)
|
|
||||||
(wah 1)
|
|
||||||
(boom 1)
|
|
||||||
(job 2)
|
|
||||||
(na 16)
|
|
||||||
(yip 9))))
|
|
||||||
|
|
||||||
(define sample-message
|
|
||||||
'(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 yip yip
|
|
||||||
sha boom))
|
|
||||||
|
|
||||||
; (length (encode sample-message sample-tree)) -> 84
|
|
||||||
; if we used a fixed length code, it would have to have length of >=3
|
|
||||||
; since there are 36 words here, the answer would be 108
|
|
||||||
|
|
@ -1,36 +0,0 @@
|
||||||
(A 1), (B 2), (C 4), ...
|
|
||||||
Tree sketch (n=5):
|
|
||||||
|
|
||||||
*
|
|
||||||
/ \
|
|
||||||
(E 16) *
|
|
||||||
/ \
|
|
||||||
(D 8) *
|
|
||||||
/ \
|
|
||||||
(C 4) *
|
|
||||||
/ \
|
|
||||||
(B 2) (A 1)
|
|
||||||
|
|
||||||
tree sketch (n=10):
|
|
||||||
*
|
|
||||||
/ \
|
|
||||||
(J 512) *
|
|
||||||
/ \
|
|
||||||
(I 256) *
|
|
||||||
/ \
|
|
||||||
(H 128) *
|
|
||||||
/ \
|
|
||||||
(G 64) *
|
|
||||||
/ \
|
|
||||||
(F 32) *
|
|
||||||
/ \
|
|
||||||
(E 16) *
|
|
||||||
/ \
|
|
||||||
(D 8) *
|
|
||||||
/ \
|
|
||||||
(C 4) *
|
|
||||||
/ \
|
|
||||||
(B 2) (A 1)
|
|
||||||
|
|
||||||
The most frequent symbol always requires exactly 1 bit.
|
|
||||||
The two least frequent symbols will always require exactly n-1 bits.
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
Searching a single node requires on the order of k operations, where
|
|
||||||
k is the number of symbols given at that node.
|
|
||||||
If the tree is roughly balanced, then the number of symbols listed in
|
|
||||||
each node on the way down should decrease exponentially, and the number
|
|
||||||
of these searches would be on the order of O(log(n)), where n is the
|
|
||||||
number of symbols generally available for encoding.
|
|
||||||
|
|
||||||
If this is true, than each encoding of a symbol would take on the order
|
|
||||||
of O(n*log(n)) operations, however if the tree is very unbalanced,
|
|
||||||
which is the case in exercise 2.71, the order of growth is roughly
|
|
||||||
O(n^2), for the least frequent symbols, and O(n), for the most common
|
|
||||||
symbol.
|
|
||||||
|
|
@ -1,50 +0,0 @@
|
||||||
a) The predicates `number?` and `variable?` can't be assimilated because they
|
|
||||||
are checking the data type of the datum itself, not the value of a specific
|
|
||||||
symbol which can be found in a table.
|
|
||||||
|
|
||||||
b) Here I'll only write the most basic version of the procedures, since the
|
|
||||||
more elaborate versions were done in previous exercises.
|
|
||||||
|
|
||||||
(define (install-deriv-package)
|
|
||||||
(define (deriv-sum operands var)
|
|
||||||
(let ((addend (car operands))
|
|
||||||
(augend (cadr operands)))
|
|
||||||
(make-sum (deriv addend var)
|
|
||||||
(deriv augend var))))
|
|
||||||
|
|
||||||
(define (deriv-product operands var)
|
|
||||||
(let ((multiplicand (car operands))
|
|
||||||
(multiplier (cadr operands)))
|
|
||||||
(make-sum
|
|
||||||
(make-product multiplier
|
|
||||||
(deriv multiplicand var))
|
|
||||||
(make-product (deriv multiplier var)
|
|
||||||
multiplicand))))
|
|
||||||
|
|
||||||
(put 'deriv '+ deriv-sum)
|
|
||||||
(put 'deriv '* deriv-product)
|
|
||||||
'done)
|
|
||||||
|
|
||||||
c) exponential rule:
|
|
||||||
...
|
|
||||||
(define (deriv-expon operands var)
|
|
||||||
(let ((base (car operands))
|
|
||||||
(exponent (cadr operands)))
|
|
||||||
(if (constant? exponent var)
|
|
||||||
(make-product (make-product exponent
|
|
||||||
(make-exponentiation base
|
|
||||||
(make-sum
|
|
||||||
exponent
|
|
||||||
-1)))
|
|
||||||
(deriv base var))
|
|
||||||
(error "non-constant exponents not yet supported: DERIV" exponent))))
|
|
||||||
...
|
|
||||||
(put 'deriv '** deriv-expon)
|
|
||||||
...
|
|
||||||
|
|
||||||
d) if the dispatch line looked like this:
|
|
||||||
((get (operator exp) 'deriv) (operands exp) var)
|
|
||||||
|
|
||||||
the only part we would really have to change is the put lines for each of the
|
|
||||||
functions, like so:
|
|
||||||
(put 'deriv '+ deriv-sum) -> (put '+ 'deriv deriv-sum)
|
|
||||||
|
|
@ -1,59 +0,0 @@
|
||||||
This is a txt file because there's no sense in trying to make it into a proper
|
|
||||||
runnable scheme file, unless I go out of my way to make several examples of
|
|
||||||
data structure and record formats, complete with examples in order to actually
|
|
||||||
run these:
|
|
||||||
|
|
||||||
a) Before any of the data records in the file itself, there should be an
|
|
||||||
identifier for what type of record it is, so each file should start with a
|
|
||||||
symbol, number or string that uniquely identifies the file structure/format,
|
|
||||||
for example:
|
|
||||||
european-division-format
|
|
||||||
(...)
|
|
||||||
(...)
|
|
||||||
...
|
|
||||||
|
|
||||||
This piece of info should be in the same position in every file, so that a
|
|
||||||
uniform function, say (get-file-type file) could be used to find the proper
|
|
||||||
format. If it's not possible to change these division formats at all, then
|
|
||||||
either this change will be done while loading the file, or, the get-file-type
|
|
||||||
function will have to be more complicated.
|
|
||||||
|
|
||||||
In any case, once we have solved the format marking issue using any kind of
|
|
||||||
method, the files and the records could be structured any how, as long as each
|
|
||||||
record has a unique identifier to the employee.
|
|
||||||
|
|
||||||
These can then be searched with different functions for different formats, all
|
|
||||||
of which could be organized in a table, and called by a master function, which
|
|
||||||
will load the record, and then attach it with a tag, which will make record
|
|
||||||
processing easier too:
|
|
||||||
|
|
||||||
(define (get-record name file)
|
|
||||||
(let ((file-type (get-file-type file)))
|
|
||||||
(attach-record-type file-type
|
|
||||||
((get 'get-record file-type) name))))
|
|
||||||
|
|
||||||
We will also assume all these functions return nil if the record doesn't
|
|
||||||
exist, or a single record if it does.
|
|
||||||
|
|
||||||
b) The way that we've written the get-record function, it doesn't matter how a
|
|
||||||
particular employee record is structured, because we tag it as the respective
|
|
||||||
file type ourselves, but of course it must contain the salary field, we must
|
|
||||||
also define a function which gets the record type, and the rest of the record:
|
|
||||||
get-record-type and get-record-body
|
|
||||||
|
|
||||||
(define (get-salary record)
|
|
||||||
((get 'get-salary (get-record-type record)) (get-record-body record)))
|
|
||||||
|
|
||||||
c) We assume there's only one employee for the given name
|
|
||||||
|
|
||||||
(define (find-employee-record name files)
|
|
||||||
(let ((returns (filter (lambda (record) (not (null? record)))
|
|
||||||
(map get-record files))))
|
|
||||||
(if (null? returns)
|
|
||||||
nil
|
|
||||||
(car returns))))
|
|
||||||
|
|
||||||
d) All changes could be done in the new company's (or department's) package,
|
|
||||||
where they would simply define a new format name, add the format name tag to
|
|
||||||
their records, modify their get-record and get-salary functions appropriately,
|
|
||||||
and then add these to the updated global function table.
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
#lang sicp
|
|
||||||
|
|
||||||
(define (make-from-real-imag r a)
|
|
||||||
(define (dispatch op)
|
|
||||||
(cond ((eq? op 'real-part) (* r (cos a)))
|
|
||||||
((eq? op 'imag-part) (* r (sin a)))
|
|
||||||
((eq? op 'magnitude) r)
|
|
||||||
((eq? op 'angle) a)
|
|
||||||
(else (error "Unknown op: MAKE-FROM-MAG-ANG" op))))
|
|
||||||
dispatch)
|
|
||||||
|
|
@ -1,32 +0,0 @@
|
||||||
Explicit dispatch:
|
|
||||||
New type: A new constructor(s), must be made for the new data type, which
|
|
||||||
will add the necessary fields and attach a new type tag. Each of the
|
|
||||||
functions for the type will need to have a new condition line to check for
|
|
||||||
the new type.
|
|
||||||
New op: The new op will be written in an explicit dispatch style to process
|
|
||||||
all of the preexisting types
|
|
||||||
|
|
||||||
Data-directed style:
|
|
||||||
New type: A new package will be written, complete with all the necessary
|
|
||||||
functions to process the new type, they will then all be added to a new
|
|
||||||
row in the table
|
|
||||||
New op: Each existing package will have the op added to it, and will also
|
|
||||||
add it to a new column in the table
|
|
||||||
|
|
||||||
Message-passing style:
|
|
||||||
New type: A new dispatch function will be created, with all of the lines
|
|
||||||
which exist in functions of previous types
|
|
||||||
New op: A new line is added into each of the dispatch functions of the
|
|
||||||
preexisting types
|
|
||||||
|
|
||||||
If new operations are often added, you may prefer the explicit dispatch style,
|
|
||||||
since it involves only creating/modifying one place in the codebase.
|
|
||||||
|
|
||||||
If new types are often added, you may instead prefer one of the other two
|
|
||||||
styles, since here, an addition of a new type is done in one place in the
|
|
||||||
code, while adding a new op requires changes in many places.
|
|
||||||
|
|
||||||
That being said, the data-directed style has the extra advantage that it could
|
|
||||||
(in principle) be written in a way that's more organized for adding new
|
|
||||||
operations, since the table structure itself will work equally well in either
|
|
||||||
case, and it's more of a matter of code organization.
|
|
||||||
Loading…
Add table
Reference in a new issue