Add 2.3 Adapters exercises.

1 files changed, 258 insertions, 0 deletions

diff --git a/chapter-2/2.3-wrappers.scm b/chapter-2/2.3-wrappers.scm
new file mode 100644
index 0000000..60d96fd
--- /dev/null
+++ b/chapter-2/2.3-wrappers.scm
@@ -0,0 +1,258 @@
+;;; Copyright © 2021 Gerald Sussman and Chris Hanson
+;;; Copyright © 2022 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(use-modules (srfi srfi-1)
+             (ice-9 match))
+
+;; Ideal gas law:
+;; PV = nRT
+;;
+;; P is the pressure, V is the volume, n is the amount of the gas, R
+;; is the gas constant, and T is the temperature.
+
+(define pi (* 4 (atan 1 1)))
+(define gas-constant 8.3144621) ; J/(K*mol)
+
+(define (gas-law-volume pressure temperature amount)
+  (/ (* amount gas-constant temperature) pressure))
+
+(define (sphere-radius volume)
+  (expt (/ volume (* 4/3 pi)) 1/3))
+
+;; The choice of gas constant makes this program in SI units, so the
+;; pressure is in newtons per square meter, the tempature is in
+;; kelvins, the amount is in moles, the volume is in cubic meters, and
+;; the radius is in meters.
+
+;; The book does not implement make-unit-conversion nor unit:inverse,
+;; so here's my take on it:
+
+(define (make-unit-conversion procedure inverse)
+  (define (conversion n)
+    (procedure n))
+  (set-procedure-property! conversion 'inverse inverse)
+  conversion)
+
+(define (unit:invert converter)
+  (procedure-property converter 'inverse))
+
+;; From the book:
+
+(define fahrenheit-to-celsius
+  (make-unit-conversion (lambda (f) (* 5/9 (- f 32)))
+                        (lambda (c) (+ (* c 9/5) 32))))
+
+(define celsius-to-kelvin
+  (let ((zero-celsius 273.15)) ; kelvins
+    (make-unit-conversion (lambda (c) (+ c zero-celsius))
+                          (lambda (k) (- k zero-celsius)))))
+
+;; 2.3.2 Implementing specializers
+
+;; To be defined in exercise below
+(define (make-converter input-unit output-unit)
+  #f)
+
+(define (unit-specializer procedure implicit-output-unit . implicit-input-units)
+  (define (specializer specific-output-unit . specific-input-units)
+    (let ((output-converter (make-converter implicit-output-unit
+                                            specific-output-unit))
+          (input-converters (map make-converter
+                                 specific-input-units
+                                 implicit-input-units)))
+      (define (specialized-procedure . arguments)
+        (output-converter
+         (apply procedure
+                (map (lambda (converter argument)
+                       (converter argument))
+                     input-converters
+                     arguments))))
+      specialized-procedure))
+  specializer)
+
+(define (unit:* u1 u2)
+  (make-unit-conversion (compose u2 u1)
+                        (compose (unit:invert u1)
+                                 (unit:invert u2))))
+
+
+;; Exercise 2.11: Implementing unit conversions
+
+
+;; a. As a warmup, write the procedures register-unit-conversion, and
+;; make-converter.
+
+(define *unit-conversions* (make-hash-table))
+
+(define (register-unit-conversion input-unit output-unit procedure)
+  (hash-set! *unit-conversions* (list input-unit output-unit) procedure))
+
+(define (make-converter input-unit output-unit)
+  (hash-ref *unit-conversions* (list input-unit output-unit)))
+
+(register-unit-conversion 'fahrenheit 'kelvin
+                          (unit:* fahrenheit-to-celsius celsius-to-kelvin))
+
+;; b. Write the procedures for unit:/ and unit:expt
+
+(define (unit:/ u1 u2)
+  (unit:* u1 (unit:invert u2)))
+
+;; This only works for positive exponents.
+(define (unit:expt unit power)
+  (define (mul i)
+    (if (= i 1)
+        unit
+        (unit:* unit (mul (- i 1)))))
+  (mul power))
+
+;; c. Fill out a library of conversions for conventional units to SI
+;; units. This requires conversion for mass and length.  (Time is in
+;; seconds in both systems.  However, you may be interested in
+;; minutes, hours, days, weeks, years, etc. Don't get stuck trying to
+;; make this universal.)
+
+(define inch-to-meter
+  (let ((ratio 0.0254))
+    (make-unit-conversion (lambda (inches) (* inches ratio))
+                          (lambda (meters) (/ meters ratio)))))
+
+(register-unit-conversion 'inch 'meter inch-to-meter)
+
+(define pound-to-newton
+  (let ((ratio 4.448))
+    (make-unit-conversion (lambda (pounds) (* pounds ratio))
+                          (lambda (newtons) (/ newtons ratio)))))
+
+(register-unit-conversion 'pound 'newton pound-to-newton)
+
+((unit:/ pound-to-newton inch-to-meter) 4) ; 700.472
+
+((unit:expt inch-to-meter 3) 12) ; 0.000197
+
+(define second-to-minute
+  (let ((seconds-per-minute 60))
+    (make-unit-conversion (lambda (seconds) (/ seconds seconds-per-minute))
+                          (lambda (minutes) (* minutes seconds-per-minute)))))
+
+(register-unit-conversion 'second 'minute second-to-minute)
+
+(define minute-to-hour
+  (let ((minutes-per-hour 60))
+    (make-unit-conversion (lambda (minutes) (/ minutes minutes-per-hour))
+                          (lambda (hours) (* hours minutes-per-hour)))))
+
+(register-unit-conversion 'minute 'hour minute-to-hour)
+
+(register-unit-conversion 'second 'hour (unit:* second-to-minute minute-to-hour))
+
+;; d. Make some useful compounds, like velocity and acceleration.
+
+(define second-to-second
+  (make-unit-conversion (lambda (seconds) seconds)
+                        (lambda (seconds) seconds)))
+
+;; Need an identity conversion.
+(register-unit-conversion 'second 'second second-to-second)
+
+(register-unit-conversion '(/ meter second) '(/ inch second)
+                          (unit:/ (unit:invert inch-to-meter) second-to-second))
+
+((unit:/ (unit:invert inch-to-meter) second-to-second) 1)
+
+;; e. For a real project, extend this specializer system for some
+;; other data conversion of some other program, having nothing to do
+;; with units.
+
+;; Calling it a unit conversion doesn't make sense in this context
+;; where we are dealing with naming conventions, not units, but that's
+;; fine for the sake of just getting through this exercise.
+(define camel-case-to-snake-case
+  (make-unit-conversion (lambda (str)
+                          (list->string
+                           (let loop ((i 0))
+                             (if (< i (string-length str))
+                                 (let ((c (string-ref str i)))
+                                   (if (char-set-contains? char-set:upper-case c)
+                                       (if (= i 0)
+                                           (cons (char-downcase c) (loop (+ i 1)))
+                                           (cons* #\_ (char-downcase c)
+                                                  (loop (+ i 1))))
+                                       (cons c (loop (+ i 1)))))
+                                 '()))))
+                        (lambda (str)
+                          (list->string
+                           (let loop ((i 0))
+                             (if (< i (string-length str))
+                                 (let ((c (string-ref str i)))
+                                   (cond
+                                    ((= i 0)
+                                     (cons (char-upcase c) (loop (+ i 1))))
+                                    ((eqv? c #\_)
+                                     (cons (char-upcase (string-ref str (+ i 1)))
+                                           (loop (+ i 2))))
+                                    (else
+                                     (cons c (loop (+ i 1))))))
+                                 '()))))))
+
+(define snake-case-to-lisp-case
+  (make-unit-conversion (lambda (str)
+                          (string-map (lambda (c)
+                                        (if (eqv? c #\_) #\- c))
+                                      str))
+                        (lambda (str)
+                          (string-map (lambda (c)
+                                        (if (eqv? c #\-) #\_ c))
+                                      str))))
+
+((unit:* camel-case-to-snake-case snake-case-to-lisp-case) "FooBar")
+
+;; f. Another big extension is to build 'make-converter' so that it
+;; can derive compound conversions, as required, from previously
+;; registered conversions.  This will require a graph search.
+
+;; Yeah... I'm gonna use Guile's pattern matcher to make my life
+;; easier, even though the book doesn't cover pattern matching until
+;; later.
+(define (make-converter input-unit output-unit)
+  (let ((unit-pair (list input-unit output-unit)))
+    (or (hash-ref *unit-conversions* unit-pair) ; cache hit
+        (match unit-pair ; cache miss
+          (((and ('/ in1 in2) in) (and ('/ out1 out2) out))
+           (let ((conversion (unit:/ (make-converter in1 out1)
+                                     (make-converter in2 out2))))
+             (register-unit-conversion in out conversion)
+             conversion))
+          (((and ('* in1 in2) in) (and ('* out1 out2) out))
+           (let ((conversion (unit:* (make-converter in1 out1)
+                                     (make-converter in2 out2))))
+             (register-unit-conversion in out conversion)
+             conversion))
+          ;; This doesn't verify that the exponents are the same, but
+          ;; it's good enough for this exercise.
+          (((and ('expt in (? number? power)) input)
+            (and ('expt out (? number? _)) output))
+           (let ((conversion (unit:expt (make-converter in out) power)))
+             (register-unit-conversion input output conversion)
+             conversion))
+          (((? symbol?) (? symbol?))
+           (error "primitive converter not registered for" unit-pair))))))
+
+;; Should be a cache miss for both divisions, then cache hit for
+;; pound->newton, then cache misses for the expts, then cache hit for
+;; inch->meter.  Subsequent calls should be immediate cache hits.
+((make-converter '(/ pound (expt inch 3)) '(/ newton (expt meter 3))) 10) ; ~2714336