sicp-exercises/sec-2-4-3-data-directed.lisp

;; 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)))))


;; finally, message passing stuff.
;; 2.75
(defun make-from-mag-ang (mag ang)
  (lambda (op)
    (cond
      ((eql op 'real-part) (* mag (cos ang)))
      ((eql op 'imag-part) (* mag (sin ang)))
      ((eql op 'magnitude) mag)
      ((eql op 'angle) ang)
      (t (error "Unknown operation.")))))

;; Ex 2.76
;; This one's a flat question, so I'm just going to answer.
;; I'm also going to explain a little bit about how this relates
;; to my prior programming experience.
;;
;; Generic operations with explicit dispatch are not very good
;; for a system that must be constantly extended and changed.
;; adding a new type is difficult - all previous functions
;; must be changed to accommodate the new type.
;; Adding a new function however, is comparatively easier
;; since the new function must only accommodate existing types,
;; and does not have to modify existing code.
;; I beleive this maps pretty easily to a procedural programm

;; Message passing however, thinks in terms of objects.
;; so adding a new type to the table is easy and can be done
;; without modifying existing objects, however, adding a new
;; function is difficult, as existing objects must be modified to accommodate
;; the new function.

;; a table-lookup, or the data directed style is most suited to
;; extremely extensible systems, as new functions can be added
;; by just adding them to the lookup table, and new types
;; can be defined by just adding new function/type combinations
;; to the table as well.

;; Note: this problem is sometimes referred to as the "expression problem."
;; especially within compiler development.