diff options
| -rw-r--r-- | chapter-2/2.3-wrappers.scm | 258 |
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 |