From a44574e9c983af47745f9558edc2e931c4b368fc Mon Sep 17 00:00:00 2001 From: Emin Arslan Date: Wed, 22 Jan 2025 14:47:21 +0300 Subject: [PATCH] Data directed programming chapter. --- sec-2-4-3-data-directed.lisp | 145 +++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 sec-2-4-3-data-directed.lisp diff --git a/sec-2-4-3-data-directed.lisp b/sec-2-4-3-data-directed.lisp new file mode 100644 index 0000000..403ae49 --- /dev/null +++ b/sec-2-4-3-data-directed.lisp @@ -0,0 +1,145 @@ +;; in this chapter we do data directed programming +;; to solve what is, essentially, the expression problem +;; or a variation of it anyway. +;; in common lisp, we do have hash tables, so we'll just use that. + + +;; exercise 2.73 +;; these aren't optimised, and they don't eliminate unnecessary elements. +;; mainly because we already did that. I'm just focusing on the data-driven +;; approach here. +(defparameter *deriv* (make-hash-table)) +(defun make-sum (a b) + (cond + ((and (numberp a) (numberp b)) (+ a b)) + ((and (numberp a) (= a 0)) b) + ((and (numberp b) (= b 0)) a) + (t (list '+ a b)))) +(defun sum-deriv (operands var) + (reduce #'make-sum + (mapcar (lambda (x) (deriv x var)) + operands))) +(setf (gethash '+ *deriv*) #'sum-deriv) + +;; the important thing to notice, here, is that we can easily +;; add another operation that we want to derive without ever modifying +;; derive or any of the other methods, by simply adding new entries to +;; the table. +;; this ease of extension is what is valuable here. +;; if I were the user of a library such as this, I could easily modify +;; this without ever touching the source. + +(defun make-product (a b) + (cond + ((and (numberp a) (numberp b)) (* a b)) + ((and (numberp a) (= a 1)) b) + ((and (numberp b) (= b 1)) a) + ((or (zerop a) (zerop b)) 0) + (t (list '* a b)))) +(defun prod-deriv (operands var) + (make-sum + (make-product (first operands) + (deriv (second operands) var)) + (make-product (deriv (first operands) var) + (second operands)))) +(setf (gethash '* *deriv*) #'prod-deriv) + + +(defun operator (e) + (car e)) +(defun operands (e) + (cdr e)) +(defun deriv ( exp var) + (cond ((numberp exp) 0) + ((symbolp exp) (if (eql exp var) 1 0)) + (t (funcall (gethash (operator exp) *deriv*) + (operands exp) + var)))) + + +;; exercise 2.74 +;; I'm going to make some assumptions here. +;; First off, I'm going to make up a data representation for each +;; division, and I'm going to make up some divisions, and employees for each division. +;; + +(defparameter *salary-getters* (make-hash-table)) +(defparameter *employee-getters* (make-hash-table)) + +(defun file-type (f) + (car f)) +(defun file-contents (f) + (cadr f)) +(defun employee-type (e) + (car e)) +(defun employee-contents (e) + (cadr e)) + +;; get-employee returns a list containing the division as a symbol as the +;; first element, and the actual data returned by the division-specific +;; function as the second element. +;; get-salary takes that list, strips the type, and calls the division +;; specific function to get the salary +(defun get-salary (rec) + (funcall (gethash (employee-type rec) *salary-getters*) + (employee-contents rec))) +(defun get-employee (name file) + (list (file-type file) ;; add the division at the front. + (funcall (gethash (file-type file) *employee-getters*) name))) + +(defparameter *div-a* (list 'A + `(("John" . ,(make-div-a-employee "John" 15 150)) + ("Jane" . ,(make-div-a-employee "Jane" 20 200)))) + "Division A has opted to use an alist for their employee file. + Further, each employee is represented as a plist, containing their name, + age, and salary.") +(defun make-div-a-employee (name age salary) + (list :name name + :age age + :salary salary)) +(defun div-a-get-salary (rec) + (getf rec :salary)) +(setf (gethash 'A *salary-getters*) #'div-a-get-salary) +(defun div-a-get-employee (name) + (cdr (assoc name (file-contents *div-a*) :test #'string=))) +(setf (gethash 'A *employee-getters*) #'div-a-get-employee) + + +(defstruct div-b-employee name age salary) +(defparameter *div-b* (list 'B (make-hash-table :test #'equalp))) +(setf (gethash "Mark" (cadr *div-b*)) + (make-div-b-employee :name "Mark" :age 190 :salary 1000)) +(setf (gethash 'B *employee-getters*) (lambda (name) (gethash name (cadr *div-b*)))) +(setf (gethash 'B *salary-getters*) #'div-b-employee-salary) + + +(get-salary (get-employee "John" *div-a*)) +;=> 150 +(get-salary (get-employee "Mark" *div-b*)) +;=> 1000 + +(defparameter *all-divisions* (list *div-a* *div-b*)) + +;; When a new company is taken over, you simply need to make sure the new +;; company's file is a list starting with the type tag, and whatever else +;; as the rest. Then you can just add the functions for each operation +;; into the *employee-getters* and *salary-getters* tables. +;; It's a little annoying that each file must be a cons cell with +;; the car being the symbol, but it does achieve the goal here. +;; presumably, in common lisp, I would be using the CLOS and methods +;; for this. + +;; okay 22/01/2025, cleaned up the functions a little bit, +;; now the division-specific salary function just gets their own +;; data structures without having to manage the type tag themselves. +;; we could potentially get rid of the type tag in the division +;; file as well, through another table that associates type tags +;; to the files... but I'm not sure if that's very robust. +;; also forces each company to be aware of the main table... +;; look, this is good enough. + +(defun find-employee (name divisions) + (loop for i in divisions do + (let ((rec (get-employee name i))) + (if (employee-contents rec) + (return rec)))))