summaryrefslogtreecommitdiff
path: root/chapter-2
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2022-07-21 15:26:08 -0400
committerDavid Thompson <dthompson2@worcester.edu>2022-08-05 11:35:30 -0400
commiteb0e8274005445629d7ebf3da22412b021b76778 (patch)
tree27d2e61f107d22d14ba6f575be877e20a0a974db /chapter-2
parente5876bf6ff4a10d111b4ce02de23fd5af7cd1f85 (diff)
Add 2.3 Adapters exercises.
Diffstat (limited to 'chapter-2')
-rw-r--r--chapter-2/2.3-wrappers.scm258
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