| |
|
| | (ns e2-73-74
(:use clojure.test))
|
| | (def *table* (ref {}))
|
| | (defn get-binding [table sym] (get (deref *table*) sym))
(defn put-binding [table sym f] (dosync (alter *table* assoc sym f)))
|
| | (defn same-variable? [exp v] (and (symbol? exp) (= exp v)))
(defn variable? [exp] (symbol? exp))
(defn operator [exp] (first exp))
(defn operands [exp] (rest exp))
|
| | (defn deriv [exp v]
(cond (number? exp) 0
(variable? exp) (if (same-variable? exp v) 1 0)
:else ((get-binding 'deriv (operator exp))
(operands exp) v)))
|
| | (defn rest-or-one [xs] (if (= (count xs) 1) (first xs) xs))
|
| | (defn install-deriv-ops []
(defn make-sum [a & x] (concat (list '+ a) x))
(defn make-product [a & x] (concat (list '* a) x))
(put-binding 'deriv '+ (fn [args v] (make-sum (deriv (first args) v)
(deriv (rest-or-one (rest args)) v))))
(put-binding 'deriv '* (fn [args v] (make-sum (make-product (deriv (rest-or-one (rest args)) v) (first args))
(make-product (deriv (first args) v) (rest-or-one (rest args)))))))
|
| | (deftest test-ops
(install-deriv-ops)
(is (= (deriv '(+ x 3) 'x) '(+ 1 0)))
(is (= (deriv '(* x y) 'x) '(+ (* 0 x) (* 1 y)))))
|
| | (put-binding 'deriv '** (fn [args v] nil))
(defn get-binding [sym op] ...)
instead of
(defn get-binding [op sym] ...)
Nothing would change in the differentiation system. We would only change the
order of arguments to the get-binding function. I didn't really understand
this exercise...
| |
The requirements for this exercise are quite vague:
- Each department has its own format for files
- Files are sets keyed by the persons name
- Keyed records are themselve sets keyed by different types of data (salary/...)
a)
In order to make a generic get-record function which will work with any
type of file we can use the same principle of data-directed programming with
additivity. We will have (a) a registry which will be used by different
departments to register their implementations and (b) a protocol which will
be implemented and registered by those departments.
| |
|
| | (def *file-registry* (ref {}))
|
| | (defn get-record [file-type person]
((get (get (deref *file-registry*) file-type) 'get-person) person))
|
| | (defn file-type-registered? [registry file-type]
(not (nil? (get (deref registry) file-type))))
|
| | (defn register-op [file op]
(assoc file (first op) (second op)))
|
| | (defn register-file [file-type & bindings]
(do (assert (not (file-type-registered? *file-registry* file-type)))
(assert (even? (count bindings)))
(dosync (alter *file-registry* assoc file-type
(reduce register-op {} (partition 2 bindings))))))
|
| | (defn install-records []
(defn get-person-a [person] (first (filter #(= (:name %) person) [{:name 'John :salary 1000}])))
(defn get-person-b [person] (first (filter #(= (:surname %) person) [{:sex 'Male :surname 'Rob :salary 2000}])))
(register-file 'department-a
'get-person get-person-a)
(register-file 'department-b
'get-person get-person-b))
Returns a sequence of elements matching the given item in the list of
given files selected by the given op (operation)
| | (defn get-in-files
[files op item]
(mapcat #(let [v ((get % op) item)]
; I think there is a clojure idiom which lets to turn nils into
; empty seqs...
(if (nil? v) [] [v])) files))
Returns a salary for the given person. Searches through all of the departments
| | (defn get-salary
[person]
(first (map #(get % :salary) (get-in-files (vals (deref *file-registry*)) 'get-person person))))
Returns one record matching the person in the given files as persons should
be unique even across departments
| | (defn find-employee-record
[person files]
(first (get-in-files files 'get-person person)))
|
| | (deftest test-find-employee
(install-records)
(is (= (find-employee-record 'John (vals (deref *file-registry*))) (get-record 'department-a 'John)))
(is (= (get-salary 'John) (:salary (get-record 'department-a 'John)))))
(register-file 'new-department-name
'get-person x
... ...)
and make sure that the person entries have a :salary tag.
| |
| | |