Refactor parts of SICP chapter 2's code

The code refactor focused on the parts related to packages in chapter 2 of SICP. It included separating different packages into their own files, implementing a generic operation system, and standardizing the function interface. This has resulted in cleaner, more maintainable, and more understandable code.

project.clj

@@ -7,7 +7,7 @@
   :source-paths ["src"]
   :test-paths ["test"]
   :main ^:skip-aot sicp
-  :target-path "build/%s"
+  :target-path "target/%s"
   :plugins [[lein-cloverage "1.2.2"]]
   :profiles {:dev      {:dependencies [[org.clojure/clojure "1.11.1"]
                                        [io.github.noahtheduke/splint "1.12"]]}

src/sicp/chapter_2/packages/install_complex.clj

@@ -0,0 +1,45 @@
+(ns sicp.chapter-2.packages.install-complex
+  (:require
+    [sicp.chapter-2.packages.op-table :as ot]
+    [sicp.chapter-2.part-4.book-2-4 :as b24]))
+
+(defn install-complex-package
+  []
+  ; Imported procedures from rectangular and polar packages
+  (letfn [(make-from-real-imag [x y] ((ot/get :make-from-real-imag :rectangular) x y))
+          (make-from-mag-ang [r a] ((ot/get :make-from-mag-ang :polar) r a))
+          ; Internal procedures
+          (add-complex
+            [z1 z2]
+            (make-from-real-imag (+ (b24/real-part z1) (b24/real-part z2))
+                                 (+ (b24/imag-part z1) (b24/imag-part z2))))
+          (sub-complex
+            [z1 z2]
+            (make-from-real-imag (- (b24/real-part z1) (b24/real-part z2))
+                                 (- (b24/imag-part z1) (b24/imag-part z2))))
+          (mul-complex
+            [z1 z2]
+            (make-from-mag-ang (* (b24/magnitude z1) (b24/magnitude z2))
+                               (+ (b24/angle z1) (b24/angle z2))))
+          (div-complex
+            [z1 z2]
+            (make-from-mag-ang (/ (b24/magnitude z1) (b24/magnitude z2))
+                               (- (b24/angle z1) (b24/angle z2))))
+          ; Interface to rest of the system
+          (tag [z] (ot/attach-tag :complex z))]
+    ; Putting functions in a map or registry
+    (ot/put :add [:complex :complex] (fn [z1 z2] (tag (add-complex z1 z2))))
+    (ot/put :sub [:complex :complex] (fn [z1 z2] (tag (sub-complex z1 z2))))
+    (ot/put :mul [:complex :complex] (fn [z1 z2] (tag (mul-complex z1 z2))))
+    (ot/put :div [:complex :complex] (fn [z1 z2] (tag (div-complex z1 z2))))
+    (ot/put :make-from-real-imag :complex (fn [x y] (tag (make-from-real-imag x y))))
+    (ot/put :make-from-mag-ang :complex (fn [r a] (tag (make-from-mag-ang r a))))
+    :done))
+
+(defn make-complex-from-real-imag
+  [x y]
+  ((ot/get :make-from-real-imag :complex) x y))
+
+(defn make-complex-from-mag-ang
+  [r a]
+  ((ot/get :make-from-mag-ang :complex) r a))

src/sicp/chapter_2/packages/install_polar.clj

@@ -0,0 +1,24 @@
+(ns sicp.chapter-2.packages.install-polar
+  (:require
+    [sicp.chapter-2.packages.op-table :as ot]))
+
+(defn install-polar-package
+  []
+  (letfn [(magnitude [z] (first z))
+          (angle [z] (second z))
+          (make-from-mag-ang [r a] (list r a))
+          (real-part [z] (* (magnitude z) (Math/cos (angle z))))
+          (imag-part [z] (* (magnitude z) (Math/sin (angle z))))
+          (make-from-real-imag
+            [x y]
+            (list (Math/sqrt (+ (Math/pow x 2) (Math/pow y 2)))
+                  (Math/atan2 y x)))
+          (tag [x] (cons :polar x))]
+    ; interface to the rest of the system
+    (ot/put :real-part :polar real-part)
+    (ot/put :imag-part :polar imag-part)
+    (ot/put :magnitude :polar magnitude)
+    (ot/put :angle :polar angle)
+    (ot/put :make-from-real-imag :polar (fn [x y] (tag (make-from-real-imag x y))))
+    (ot/put :make-from-mag-ang :polar (fn [r a] (tag (make-from-mag-ang r a))))
+    :done))

src/sicp/chapter_2/packages/install_rational.clj

@@ -0,0 +1,44 @@
+(ns sicp.chapter-2.packages.install-rational
+  (:require
+    [sicp.chapter-2.packages.op-table :as ot]
+    [sicp.misc :as m]))
+
+(defn install-rational-package
+  []
+  ; Internal procedures
+  (letfn [(numer [x] (first x))
+          (denom [x] (second x))
+          (make-rat
+            [n d]
+            (let [g (m/gcd n d)]
+              (m/pair (/ n g) (/ d g))))
+          (add-rat
+            [x y]
+            (make-rat (+ (* (numer x) (denom y))
+                         (* (numer y) (denom x)))
+                      (* (denom x) (denom y))))
+          (sub-rat
+            [x y]
+            (make-rat (- (* (numer x) (denom y))
+                         (* (numer y) (denom x)))
+                      (* (denom x) (denom y))))
+          (mul-rat
+            [x y]
+            (make-rat (* (numer x) (numer y))
+                      (* (denom x) (denom y))))
+          (div-rat
+            [x y]
+            (make-rat (* (numer x) (denom y))
+                      (* (denom x) (numer y))))
+          ; Interface to rest of the system
+          (tag [x] (ot/attach-tag :rational x))]
+    (ot/put :add [:rational :rational] (fn [x y] (tag (add-rat x y))))
+    (ot/put :sub [:rational :rational] (fn [x y] (tag (sub-rat x y))))
+    (ot/put :mul [:rational :rational] (fn [x y] (tag (mul-rat x y))))
+    (ot/put :div [:rational :rational] (fn [x y] (tag (div-rat x y))))
+    (ot/put :make :rational (fn [n d] (tag (make-rat n d))))
+    :done))
+
+(defn make-rational
+  [n d]
+  ((ot/get :make :rational) n d))

src/sicp/chapter_2/packages/install_rectangular.clj

@@ -0,0 +1,25 @@
+(ns sicp.chapter-2.packages.install-rectangular
+  (:require
+    [sicp.chapter-2.packages.op-table :as ot]))
+
+(defn install-rectangular-package
+  []
+  ; internal procedures
+  (letfn [(real-part [z] (first z))
+          (imag-part [z] (second z))
+          (make-from-real-imag [x y] (list x y))
+          (magnitude
+            [z]
+            (Math/sqrt (+ (Math/pow (real-part z) 2)
+                          (Math/pow (imag-part z) 2))))
+          (angle [z] (Math/atan2 (imag-part z) (real-part z)))
+          (make-from-mag-ang [r a] (list (* r (Math/cos a)) (* r (Math/sin a))))
+          (tag [x] (ot/attach-tag :rectangular x))]
+    ; interface to the rest of the system
+    (ot/put :real-part '(:rectangular) real-part)
+    (ot/put :imag-part '(:rectangular) imag-part)
+    (ot/put :magnitude '(:rectangular) magnitude)
+    (ot/put :angle '(:rectangular) angle)
+    (ot/put :make-from-real-imag :rectangular (fn [x y] (tag (make-from-real-imag x y))))
+    (ot/put :make-from-mag-ang :rectangular (fn [r a] (tag (make-from-mag-ang r a))))
+    :done))

src/sicp/chapter_2/packages/install_scheme_number.clj

@@ -0,0 +1,17 @@
+(ns sicp.chapter-2.packages.install-scheme-number
+  (:require
+    [sicp.chapter-2.packages.op-table :as ot]))
+
+(defn install-scheme-number-package
+  []
+  (letfn [(tag [x] (ot/attach-tag :scheme-number x))]
+    (ot/put :add [:scheme-number :scheme-number] (fn [x y] (tag (+ x y))))
+    (ot/put :sub [:scheme-number :scheme-number] (fn [x y] (tag (- x y))))
+    (ot/put :mul [:scheme-number :scheme-number] (fn [x y] (tag (* x y))))
+    (ot/put :div [:scheme-number :scheme-number] (fn [x y] (tag (/ x y))))
+    (ot/put :make :scheme-number (fn [x] (tag x)))
+    :done))
+
+(defn make-scheme-number
+  [n]
+  ((ot/get :make :scheme-number) n))

src/sicp/chapter_2/packages/op_table.clj

@@ -0,0 +1,36 @@
+(ns sicp.chapter-2.packages.op-table
+  (:refer-clojure :exclude [get])
+  (:require
+    [clojure.pprint :as pp]))
+
+(comment "Custom helper functions. Made myself, just for testing ---------------------------------")
+
+(def operation-table (atom {}))
+
+(defn attach-tag
+  [tag value]
+  {:tag tag, :contents value})
+
+(defn put
+  [operation types procedure]
+  (swap! operation-table assoc-in [operation types] procedure))
+
+(defn get
+  [operation types]
+  (get-in @operation-table [operation types]))
+
+(defn apply-generic
+  [op & args]
+  (let [type-tags (map #(-> % :tag) args)
+        operation (get op type-tags)]
+    (if operation
+      (apply operation (map #(:contents %) args))
+      (throw (IllegalArgumentException. (str "No method for: " op))))))
+
+(defn inspect
+  []
+  (->> @operation-table
+       (map (fn [item]
+              {:operation (first item)
+               :types     (first (first (into '() (second item))))}))
+       (pp/print-table)))

src/sicp/chapter_2/part_4/book_2_4.clj

@@ -91,15 +91,15 @@
 
 (defn type-tag
   [datum]
-  (if (sequential? datum)
-    (first datum)
-    (throw (Exception. (str "Bad tagged datum: TYPE-TAG " datum)))))
+  (cond (sequential? datum) (first datum)
+        (map? datum) (get datum :tag)
+        :else (throw (Exception. (str "Bad tagged datum: TYPE-TAG " datum)))))
 
 (defn contents
   [datum]
-  (if (sequential? datum)
-    (rest datum)
-    (throw (Exception. (str "Bad tagged datum: CONTENTS " datum)))))
+  (cond (sequential? datum) (rest datum)
+        (map? datum) (get datum :contents)
+        :else (throw (Exception. (str "Bad tagged datum: CONTENTS " datum)))))
 
 (defn rectangular?
   [z]
@@ -215,6 +215,7 @@
 ; * 2.76
 
 (defn apply-generic
+  "Just a wrapper for the dispatch table. It's a bit more verbose than the original, I don't use it"
   [op & args]
   (let [type-tags (map type-tag args)
         proc      (get op type-tags)]

src/sicp/chapter_2/part_5/book_2_5.clj

@@ -1,145 +1,30 @@
 (ns sicp.chapter-2.part-5.book-2-5
   (:require
-    [sicp.chapter-2.part-4.book-2-4 :as b24]
-    [sicp.misc :as m]))
+    [sicp.chapter-2.packages.op-table :as ot]))
 
 (comment "2.5 Systems with Generic Operations ----------------------------------------------------")
 
 (comment "2.5.1 Generic Arithmetic Operations ----------------------------------------------------")
 
-; Custom helper functions. Made myself, just for testing -------------------------------------------
-
-(def operation-table (atom {}))
-
-(defn attach-tag
-  [tag value]
-  {:tag tag, :contents value})
-
-(defn put-op
-  [operation types procedure]
-  (swap! operation-table assoc-in [operation types] procedure))
-
-(defn get-op
-  [operation types]
-  (get-in @operation-table [operation types]))
-
-(defn apply-generic
-  [op & args]
-  (let [type-tags (map #(-> % :tag) args)
-        operation (get-op op type-tags)]
-    (if operation
-      (apply operation (map #(:contents %) args))
-      (throw (IllegalArgumentException. (str "No method for: " op))))))
-
-; --------------------------------------------------------------------------------------------------
-
 (defn add
   [x y]
-  (apply-generic :add x y))
+  (ot/apply-generic :add x y))
 
 (defn sub
   [x y]
-  (apply-generic :sub x y))
+  (ot/apply-generic :sub x y))
 
 (defn mul
   [x y]
-  (apply-generic :mul x y))
+  (ot/apply-generic :mul x y))
 
 (defn div
   [x y]
-  (apply-generic :div x y))
-
-(defn install-scheme-number-package
-  []
-  (letfn [(tag [x] (attach-tag :scheme-number x))]
-    (put-op :add [:scheme-number :scheme-number] (fn [x y] (tag (+ x y))))
-    (put-op :sub [:scheme-number :scheme-number] (fn [x y] (tag (- x y))))
-    (put-op :mul [:scheme-number :scheme-number] (fn [x y] (tag (* x y))))
-    (put-op :div [:scheme-number :scheme-number] (fn [x y] (tag (/ x y))))
-    (put-op :make :scheme-number (fn [x] (tag x)))
-    :done))
-
-(defn install-rational-package
-  []
-  ; Internal procedures
-  (letfn [(numer [x] (first x))
-          (denom [x] (second x))
-          (make-rat
-            [n d]
-            (let [g (m/gcd n d)]
-              (m/pair (/ n g) (/ d g))))
-          (add-rat
-            [x y]
-            (make-rat (+ (* (numer x) (denom y))
-                         (* (numer y) (denom x)))
-                      (* (denom x) (denom y))))
-          (sub-rat
-            [x y]
-            (make-rat (- (* (numer x) (denom y))
-                         (* (numer y) (denom x)))
-                      (* (denom x) (denom y))))
-          (mul-rat
-            [x y]
-            (make-rat (* (numer x) (numer y))
-                      (* (denom x) (denom y))))
-          (div-rat
-            [x y]
-            (make-rat (* (numer x) (denom y))
-                      (* (denom x) (numer y))))
-          ; Interface to rest of the system
-          (tag [x] (attach-tag :rational x))]
-    (put-op :add [:rational :rational] (fn [x y] (tag (add-rat x y))))
-    (put-op :sub [:rational :rational] (fn [x y] (tag (sub-rat x y))))
-    (put-op :mul [:rational :rational] (fn [x y] (tag (mul-rat x y))))
-    (put-op :div [:rational :rational] (fn [x y] (tag (div-rat x y))))
-    (put-op :make :rational (fn [n d] (tag (make-rat n d))))
-    :done))
-
-(defn install-complex-package
-  []
-  ; Imported procedures from rectangular and polar packages
-  (letfn [(make-from-real-imag [x y] ((get-op :make-from-real-imag :rectangular) x y))
-          (make-from-mag-ang [r a] ((get-op :make-from-mag-ang :polar) r a))
-          ; Internal procedures
-          (add-complex
-            [z1 z2]
-            (make-from-real-imag (+ (b24/real-part z1) (b24/real-part z2))
-                                 (+ (b24/imag-part z1) (b24/imag-part z2))))
-          (sub-complex
-            [z1 z2]
-            (make-from-real-imag (- (b24/real-part z1) (b24/real-part z2))
-                                 (- (b24/imag-part z1) (b24/imag-part z2))))
-          (mul-complex
-            [z1 z2]
-            (make-from-mag-ang (* (b24/magnitude z1) (b24/magnitude z2))
-                               (+ (b24/angle z1) (b24/angle z2))))
-          (div-complex
-            [z1 z2]
-            (make-from-mag-ang (/ (b24/magnitude z1) (b24/magnitude z2))
-                               (- (b24/angle z1) (b24/angle z2))))
-          ; Interface to rest of the system
-          (tag [z] (attach-tag :complex z))]
-    ; Putting functions in a map or registry
-    (put-op :add [:complex :complex] (fn [z1 z2] (tag (add-complex z1 z2))))
-    (put-op :sub [:complex :complex] (fn [z1 z2] (tag (sub-complex z1 z2))))
-    (put-op :mul [:complex :complex] (fn [z1 z2] (tag (mul-complex z1 z2))))
-    (put-op :div [:complex :complex] (fn [z1 z2] (tag (div-complex z1 z2))))
-    (put-op :make-from-real-imag :complex (fn [x y] (tag (make-from-real-imag x y))))
-    (put-op :make-from-mag-ang :complex (fn [r a] (tag (make-from-mag-ang r a))))
-    :done))
-
-(defn make-scheme-number
-  [n]
-  ((get-op :make :scheme-number) n))
-
-(defn make-rational
-  [n d]
-  ((get-op :make :rational) n d))
-
-(defn make-complex-from-real-imag
-  [x y]
-  ((get-op :make-from-real-imag :complex) x y))
-
-(defn make-complex-from-mag-ang
-  [r a]
-  ((get-op :make-from-mag-ang :complex) r a))
+  (ot/apply-generic :div x y))
+
+(comment
+  "See also:"
+  "sicp.chapter-2.packages.install-scheme-number"
+  "sicp.chapter-2.packages.install-rational"
+  "sicp.chapter-2.packages.install-rectangular"
+  "sicp.chapter-2.packages.install-complex")