Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

data-directed and message passing styles

  • Loading branch information...
commit 77da674fb798e6f8b3ac8914fbfcf8e44e5d7685 1 parent 8bcaf3c
@sarabander authored
Showing with 217 additions and 0 deletions.
  1. +52 −0 2.4/2.73.scm
  2. +125 −0 2.4/2.74.scm
  3. +20 −0 2.4/2.75.scm
  4. +20 −0 2.4/2.76.scm
View
52 2.4/2.73.scm
@@ -0,0 +1,52 @@
+
+(define (deriv exp var)
+ (cond ((number? exp) 0)
+ ((variable? exp)
+ (if (same-variable? exp var) 1 0))
+ (else
+ ((get 'deriv (operator exp))
+ (operands exp)
+ var))))
+
+(define (operator exp) (car exp))
+
+(define (operands exp) (cdr exp))
+
+;; a. The separate differentiation rules were replaced by single dispatch.
+;; It extracts the operator from expression, and looks up the row with
+;; 'deriv and the operator from the table. It then applies the found
+;; derivation procedure to operands, using var as differentiation variable.
+
+;; number? and variable? can't be assimilated because they deal with the
+;; case when the expression is an atom, not a list. The get procedure
+;; needs a list to work.
+
+;; b.
+
+;; For two operands. Needs generalizing.
+
+(define (deriv-sum operands var)
+ (make-sum (deriv (first operands) var)
+ (deriv (second operands) var)))
+
+(define (deriv-product operands var)
+ (make-sum
+ (make-product (first operands)
+ (deriv (second operands) var))
+ (make-product (deriv (first operands) var)
+ (second operands))))
+
+
+(put 'deriv '+ deriv-sum)
+
+(put 'deriv '* deriv-product)
+
+;; c.
+
+(define (deriv-cosine operand var)
+ (- (make-product ('sin (first operand))
+ (deriv (first operand)))))
+
+(put 'deriv 'cos deriv-cosine)
+
+;; d. We only need to change the definition of get and put.
View
125 2.4/2.74.scm
@@ -0,0 +1,125 @@
+
+;; Suppose we have two divisions with different personnel files:
+
+(define division1
+ '(div1
+ ("Mark Morning" (address "23 Sunny St.") (salary 1240))
+ ("Edna Evening" (address "41 Moon St.") (salary 1710))))
+
+(define division2
+ '(div2
+ ((name "Kelly Gardner") (wage 1305) (addr "12 Main Rd."))
+ ((name "Suzie Bee") (wage 2100) (addr "37 Main Rd."))
+ ((name "Joseph McCoy") (wage 1530) (addr "3 Lakeside Blvd."))))
+
+;; A hash table to hold file reading operations:
+(define file-ops (make-hash))
+
+;; Getter and setter to access the hash table:
+(define (retrieve-op op type)
+ (hash-ref file-ops (list op type) false))
+(define (set-op op type proc)
+ (hash-set! file-ops (list op type) proc))
+
+;; a.
+
+;; Generic procedure to retrieve employee's record from any file:
+(define (get-record name file)
+ ((retrieve-op 'employee (type-tag file)) name file))
+
+;; Populating the table with procedures:
+(set-op 'employee 'div1
+ (λ (name file)
+ (let ((result (filter (λ (emprecord)
+ (equal? (car emprecord)
+ name))
+ (cdr file))))
+ (if (empty? result)
+ false
+ (car result)))))
+
+(set-op 'employee 'div2
+ (λ (name file)
+ (let ((result (filter (λ (emprecord)
+ (equal? (cadar emprecord)
+ name))
+ (cdr file))))
+ (if (empty? result)
+ false
+ (car result)))))
+
+;; Tests
+(get-record "Mark Morning" division1) ; 8-D
+(get-record "Mark Night" division1) ; :-(
+(get-record "Edna Evening" division1) ; 8-D
+(get-record "Mark Morning" division2) ; :-(
+
+(get-record "Suzie Quattro" division2) ; :-(
+(get-record "Suzie Bee" division2) ; 8-D
+(get-record "Kelly Gardner" division2) ; 8-D
+(get-record "Joseph McCoy" division2) ; 8-D
+
+;; b.
+
+;; Generic procedure to retrieve employee's salary from any file:
+(define (get-salary name file)
+ ((retrieve-op 'salary (type-tag file)) name file))
+
+;; Populating the table with procedures:
+(set-op 'salary 'div1
+ (λ (name file)
+ (let ((result (filter (λ (emprecord)
+ (equal? (car emprecord)
+ name))
+ (cdr file))))
+ (if (empty? result)
+ false
+ (cadar (filter (λ (field) (eq? (car field)
+ 'salary))
+ (cdar result)))))))
+
+(set-op 'salary 'div2
+ (λ (name file)
+ (let ((result (filter (λ (emprecord)
+ (equal? (cadar emprecord)
+ name))
+ (cdr file))))
+ (if (empty? result)
+ false
+ (cadar (filter (λ (field) (eq? (car field)
+ 'wage))
+ (car result)))))))
+
+;; Tests
+(get-salary "Mark Morning" division1) ; 1240
+(get-salary "Mark Night" division1) ; employee not found
+(get-salary "Edna Evening" division1) ; 1710
+(get-salary "Mark Morning" division2) ; employee not found
+
+(get-salary "Frodo Baggins" division2) ; employee not found
+(get-salary "Suzie Bee" division2) ; 2100
+(get-salary "Kelly Gardner" division2) ; 1305
+(get-salary "Joseph McCoy" division2) ; 1530
+
+;; c.
+
+(define (true? x) (not (false? x)))
+
+(define (find-employee-record name files)
+ (let ((result (filter true?
+ (map (λ (file) (get-record name file))
+ files))))
+ (if (empty? result)
+ "Employee not found"
+ (car result))))
+
+
+(find-employee-record "Bilbo" (list division1 division2))
+; "Employee not found"
+(find-employee-record "Kelly Gardner" (list division1 division2)) ; found
+(find-employee-record "Mark Morning" (list division1 division2)) ; found
+
+;; d.
+
+;; We only must add one procedure per accessor operation (like get-record
+;; or get-salary) to the hashtable.
View
20 2.4/2.75.scm
@@ -0,0 +1,20 @@
+
+(define (make-from-mag-ang 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)
+
+;; Example
+(define complex1 (make-from-mag-ang 12 (/ pi 4)))
+
+(complex1 'magnitude) ; 12
+(complex1 'angle) ; 0.7853981633974483
+(complex1 'real-part) ; 8.485281374238571
+(complex1 'imag-part) ; 8.485281374238571
+
+(sqrt (* 2 (sqr 8.485281374238571))) ; 12
View
20 2.4/2.76.scm
@@ -0,0 +1,20 @@
+
+;; I would argue that adding a new operation is easier to the "generic
+;; operations with explicit dispatch" style. There the operation is defined
+;; in one place as a single definition. All the type predicates are listed
+;; there. To make a new operation, one could take an existing operation
+;; definition as a template and implement all the needed selectors and
+;; constructors working on the contents. The amount of work depends on the
+;; number of types in the system. To add a new type to this system requires
+;; finding all the operation definitions, and adding type predicates and
+;; corresponding methods to each of them.
+
+;; Adding a new type is easier to both the data-directed style and message-
+;; passing style. In data-directed system we just need to install a new
+;; representation package as a self-contained procedure definition into the
+;; table. To add a type to message-passing system, we again need to define
+;; just one procedure that encapsulates the dispatch on operation. This
+;; definition could be large if there are many operations, but at least it
+;; is all in one place. On the other hand, we need to find all the definitions
+;; of message-passing style types and all the type representation packages
+;; from the table to add a new operation to these two systems.
Please sign in to comment.
Something went wrong with that request. Please try again.