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