数据导向的程序设计1

当遇上有多种数据类型（计算方式）的过程时，如果挨个定义其计算方式，则面临整个过程需要重构的问题，在定义关键词和过程名称时也会受到较多限制。
通过构建复数系统的过程，我们可以进行观察。
复数我们可以采用直角坐标系或者极坐标系进行表达，因此在构建复数过程的时我们就面临区分两种坐标系的困难。

点击查看代码

;直角坐标系到极坐标系的转换
(define (real-part-rectangular z) (car z))
(define (imag-part-rectangular z) (cdr z))
(define (magnitude-rectangular z)
    (sqrt (+ (square (real-part-rectangular z)) (square (imag-part-rectangular z)))))
(define (square x)
    (* x x))
(define (angle-rectangular z)
    (atan (imag-part-rectangular z) (real-part-rectangular z)))

;极坐标系在直角坐标系的表示
(define (real-part-polar z)
    (* (magnitude-polar z) (cos (angle-polar z))))
(define (imag-part-polar z)
    (* (magnitude-polar z) (sin (angle-polar z))))
(define (magnitude-polar z) (car z))
(define (angle-polar z) (cdr z))

;区分极坐标和直角坐标系
(define (attach-tag type-tag contents)
    (cons type-tag contents))
(define (type-tag datum)
    (if (pair? datum)
        (car datum)
        (error "Bad tagged datum")))
(define (contents datum)
    (if (pair? datum)
        (cdr datum)
        (error "Bad content datum")))
(define (rectangular? datum)
    (eq? (type-tag datum) 'rectangular))
(define (polar? datum)
    (eq? (type-tag datum) 'polar))

可以看到这种表示方式面临很长的过程名和关键词定义问题，容易在定义过程时出错。
那么我们可以通过定义一个表，对操作和类型进行分类，后续只要赋予对应过程一个关键词，就能检索出对应的操作。
因此我们定义一个put，和一个get功能。

点击查看代码

(put op type item)
;将item加入表格，并采用op和type作为其关键词
(get op type)
;在表中查找op和type对应的项

通过该过程，我们可以对复数的构造过程进行改写。

点击查看代码

;通过一个包，我们可以打包直角坐标系下所有操作的内容，并且由于写在包体里，不需要担心关键词的复用
(define (install-rectangular-package)
    (define (real-part z) (car z))
    (define (imag-part z) (cdr z))
    (define (magnitude z)
        (sqrt (+ (square (real-part z)) (square (imag-part z)))))
    (define (angle z)
        (atan (imag-part z) (real-part z)))
    (define (make-from-real-imag x y) 
        (cons x y))
    (define (make-from-mag-ang r a) 
        (cons (* r (cos a)) (* r (sin a))))
    
    (define (tag x) (attach-tag 'rectangular x))
    (put 'real-part (rectangular) real-part)
    (put 'imag-part (rectangular) imag-part)
    (put 'agnitude (rectangular) agnitude)
    (put 'angle (rectangular) angle)
    (put 'make-from-real-imag 'rectangle
         (lambda (x y) (tag (make-from-real-imag x y))))
    (put 'make-from-mag-ang 'rectangle
         (lambda (r a) (tag (make-mag-ang x y))))
    'done)

练习2.73 2.3.2节描述了一个执行符号求导的程序：

点击查看代码

(define (deriv exp var)
    (cond ((number? exp) 0)
          ((variable? exp) (if (same-variable? exp var) 1 0))
          ((sum? exp)
           (make-sum (deriv (addend exp) var)
                     (deriv (augend exp) var)))
          ((product? exp)
           (make-sum
            (make-product (multiplier exp)
                          (deriv (multiplicand exp) var))
            (make-product (deriv (multiplier exp) var)
                          (multiplicand exp))))
          (else (error "unknown type -- DERIV" exp))))
(define (variable? x) (symbol? x))
(define (same-variable? x1 x2) (and (variable? x1) (variable? x2) (eq? x1 x2) ))
(define (make-sum a1 a2) (list '+ a1 a2))
(define (make-product m1 m2) (list '* m1 m2))
(define (sum? x) (and (pair? x) (eq? (car x) '+)))
(define (product? x) (and (pair? x) (eq? (car x) '*)))

可以认为，该程序是在执行一种基于被求导表达式类型的分派工作。其分类标志就是代数运算符，执行的操作是deriv，那么请通过数据导向的风格，重写该求导过程。

点击查看代码

(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）该过程通过get读取deriv的运算类型，执行不同的求导操作。我们无法将number？和variable？过程放入数据导向的过程中，因为这两个过程都不涉及代数运算符号，如果要放进数据导向的过程中，需要额外给他们定义数据运算符，使过程变得复杂。
b) 构建求导过程的包体

点击查看代码

(define (install-deriv-package exp var)
    (define (deriv-sum exp var)
        (define (addend s)(car s))
        (define (augend s)(cdr s))
        (make-sum (deriv (addend s) var)
                  (deriv (augend s) var)))
    (define (deriv-product exp var)
        (define (multiplicand s) (car s))
        (define (multiplier s) (cdr s))
        (make-sum
            (make-product (multiplier exp)
                          (deriv (multiplicand exp) var))
            (make-product (multiplicand exp)
                          (deriv (multiplier exp) var))))
    (put 'deriv-sum '+ deriv-sum)
    (put 'deriv-product '* deriv-product) 
    'done)

练习2.74 某个公司的结构较分散，要求构建一个过程能够使总部能够查询某个雇员的信息，薪水等内容。
该题的信息给的不是很全，包括表的构建之类的，所以过程大概写写。

点击查看代码

(define (get-record company name)
    ((get 'get-record 'company) name))
(define (get-salary company name)
    ((get 'get-salary 'company) name))
(define (find-employee-record companys employee) 
    (if (null? companys) #f
        (let ((ret ((get 'find-employee-record (car companys)) employee)))
            (if ret
                ret
                (find-emplyee-record (cdr companys) employee)))))

(define (install-company-package)
    (define (get-record employee)
        ############)

(put 'get-record 'company get-record)
(put 'get-salary 'company get-salary))