;;; To use this program, cut-paste this whole file into DrScheme,
;;; and then call the function convert, as described:
;
; (convert tyme prefix unit): number, symbol, symbol --> (list number symbol symbol)
;
; Convert a time (with metric prefix and units) to an equivalent one;
; This algorithm makes sure you end up with millenia, rather than kiloyears.
;
;; THe valid prefixes and units are:
;;    prefixes: atto, femto, pico, nano, micro, milli, single, kilo, mega, giga, tera, peta
;;    units:    seconds, minutes, hours, days, years, centuries, millenia, recorded-histories, earths-ages, universe-lifetimes.
;
;; Test cases:
;(convert 478234  'micro  'seconds) = (list 478.234   'milli  'seconds)
;(convert 1e23    'atto 'seconds)   = (list #i1.15740 'single 'days)
; Note that "1e23" is shorthand for "10^23", that is, a "1" followed by 23 "0"s.



; Note: DrScheme has the following math functions built-in:
;   (log x):  the natural log of x (base e)
;   (expt a b):  a raised to the b power.
;     (expt 2 10) = 1024
;
;  We'll also define:
(define (log10 x)
  (/ (log x) (log 10)))

;;-----------------------------------------
;; How this program works:
;; THe data we use are:
;; Amounts: (list number symbol symbol),
;; representing a magnitude, a metric prefix, and a unit.
;;    E.g.: (list 470 'milli 'years).
;; See below for the list of valid prefixes and units.
;;
;; Records: (list number symbol 'per symbol)
;;   Intended as a conversion factor between two Amounts.  E.g.
;;   (list 60     'seconds   'per 'minutes)
;;   (list 1000   'micro  'per 'milli)
;;  
;; THe valid prefixes and units are:
;;    prefixes: atto, femto, pico, nano, micro, milli, single, kilo, mega, giga, tera, peta
;;    units:    seconds, minutes, hours, days, years, centuries, millenia, recorded-histories, earths-ages, universe-lifetimes.
;;


;; (invert record): record --> record
;; Given a conversion record, invert it:
(define (invert record)
  (list (/ 1 (first record)) (fourth record) (third record) (second record)))

; (invert (list 24 'hrs 'per 'days)) = (list 1/24 'days 'per 'hrs)



(define conversions (list (list 60     'seconds   'per 'minutes)
                          (list 60     'minutes   'per 'hours)
                          (list 24     'hours     'per 'days)
                          (list 365.24 'days      'per 'years)
                          (list 100    'years     'per 'centuries)
                          (list 10     'centuries 'per 'millenia)
                          (list 6      'millenia  'per 'recorded-histories)
                          (list 1000000 'recorded-histories 'per 'earths-ages)
                          (list 2.5    'earths-ages 'per 'universe-lifetimes)))


(define prefixes    (list (list 1000   'atto   'per  'femto)
                          (list 1000   'femto  'per 'pico)
                          (list 1000   'pico   'per 'nano)
                          (list 1000   'nano   'per 'micro)
                          (list 1000   'micro  'per 'milli)
                          (list 1000   'milli  'per 'single)
                          (invert (list 1000 'single 'per 'kilo))
                          (invert (list 1000 'kilo   'per 'mega))
                          (invert (list 1000 'mega   'per 'giga))
                          (invert (list 1000 'giga   'per 'tera))
                          (invert (list 1000 'peta   'per 'tera))))

  ; Note: it is important that all these prefix-conversions all
  ; lead *towards* 'single.  That's why the second half are inverted.



; We need to define these, so later functions know
; when to stop trying to make things smaller:
;
(define smallest-prefix 'atto)
(define biggest-unit 'universe-lifetimes)

; ----------- end user setup


; Also make the lists containing the inverted Records:
;
(define unconversions (map invert conversions))
(define unprefixes (map invert prefixes))



; Define functions to extract info from an Amount:
(define (amount-prefix amt) (second amt))
(define (amount-unit   amt) (third  amt))
(define (amount-magnitude amt) (first amt))

;Examples:
;(amount-magnitude (list 473 'micro 'seconds)) = 473
;(amount-prefix    (list 473 'micro 'seconds)) = 'micro


;; (get-record records keyword): list-of record, symbol --> record
;; Where a record is the things in "conversions" and "prefixes", like
;;   (list 1000 'micro 'per 'milli)
;;
(define (get-record records keyword)
  (if (empty? records)
      (error 'get-record (format "Couldn't find ~s." keyword))
      (if (symbol=? keyword (second (first records)))
          (first records)
          (get-record (rest records) keyword))))

;(get-record prefixes 'milli)    = (list 1000 'milli 'per 'single)
;(get-record conversions 'years) = (list 100 'years 'per 'centuries)


;; (remove-one-prefix amt conversion-record): Amount, Record --> Amount.
;; Change amount to have a prefix close to "single",
;; changing the magnitude correspondingly.
;;
(define (remove-one-prefix amt conversion-record)
  (list (/ (amount-magnitude amt) (first conversion-record))
        (fourth conversion-record)
        (amount-unit amt)))

;(remove-one-prefix (list 123456 'micro 'seconds) (list 1000 'micro 'per 'milli))
;    = (list 123.456 'milli 'seconds)


;; (remove-prefix amt): Amount --> Amount
;; Convert the Amount to have the prefix 'single.
;;
(define (remove-prefix amt)
  (if (symbol=? 'single (amount-prefix amt))
      amt
      (remove-prefix (remove-one-prefix amt (get-record prefixes (amount-prefix amt)) ))))

;(remove-prefix (list 437 'milli 'years)) = (list .437 'single 'years)
;(remove-prefix (list 437 'kilo  'years)) = (list 437000 'single 'years)



;; (enlarge-one-unit amt conversion-record) : Amount, Record --> Amount
;; Change the unit to be a large one (diminishing the magnitude correspondingly).
;; The record's second unit has to correspond to the Amount's unit.
;;
(define (enlarge-one-unit amt conversion-record)
  (list (/ (amount-magnitude amt) (first conversion-record))
        (amount-prefix amt)
        (fourth conversion-record)))
  

;; We start with many seconds, and keep going to larger units
;; until we have less than one (or, we can't go further).
;;
(define (help-enlarge-time-units current previous)
  (if (< (amount-magnitude current) 1)
      previous
      (if (symbol=? biggest-unit (amount-unit current))
          current
          (help-enlarge-time-units
           (enlarge-one-unit current (get-record conversions (amount-unit current)))
           current))))

;; (enlarge-time-units amt): Amount --> Amount
;; Make the time units as large as possible, stopping
;; only when we have less than one, or have reached biggest-unit.
;;
(define (enlarge-time-units amt) (help-enlarge-time-units amt amt))

;(enlarge-time-units (list 59 'single 'seconds))
;  = (list 59 'single 'seconds)
;(enlarge-time-units (list 120 'single 'seconds)) 
;  = (list 2 'single 'minutes)
;(enlarge-time-units (list (* 60 120) 'single 'seconds))
;  = (list 2 'single 'hours)



;; (ensmall-one-prefix amt conversion-record): Amount, Record --> Amount
;; Make the metric prefix one smaller (and the magnitude correspondingly bigger).
;; The Record's second field must be the same ast the Amount's unit.
;;
(define (ensmall-one-prefix amt conversion-record)
  (list (/ (amount-magnitude amt) (first conversion-record))
        (fourth conversion-record)
        (amount-unit amt)))
;(ensmall-one-prefix (list 0.470 'single 'seconds) (list 1/1000 'single 'per 'milli))
;  = (list 470 'milli 'seconds)


;; (help-ensmall-prefix current previous): Amount, Amount --> Amount
;; Call ensmall-one-prefix repeatedly, until the prefix is small enough.
;; Initially, current and previous can be identical.
;;
(define (help-ensmall-prefix current previous)
  (if (or (symbol=? smallest-prefix (amount-prefix current))
          (> (amount-magnitude current) 1))
      current
      (help-ensmall-prefix
       (ensmall-one-prefix current (get-record unprefixes (amount-prefix current)))
       current)))

;; (ensmall-prefix amt): Amount, Amount --> Amount
;; Call ensmall-one-prefix repeatedly, until the prefix is small enough.
;;
(define (ensmall-prefix amt) (help-ensmall-prefix amt amt))

;(ensmall-prefix (list .470 'single 'seconds))
;  = (list 470 'milli 'seconds)

;(ensmall-prefix (list .000000470 'single 'seconds))
;  = (list 470 'nano 'seconds)


;; (make-inexact amt): Amount --> Amount
;; Return the same input, but convert from (any) fraction to an inexact (#i) number.
;; Useful for getting turning weird amounts like 117/233 years into decimals.
;;
(define (make-inexact amt)
  (list (exact->inexact (first amt)) (second amt) (third amt)))







; (convert tyme prefix unit): number, symbol, symbol --> (list number symbol symbol)
; Convert a time (with metric prefix and units) to an equivalent one;
; This algorithm makes sure you end up with millenia, rather than kiloyears.
;
; First remove the prefix,
; then convert units to get close to (and bigger than) 1;
; then (if we are < 1 seconds) re-install a metric prefix.
; (We keep large units (universe-lifetimes) as singles, rather than attaching kilo-, etc.)
;
(define (convert tyme prefix unit)
  (make-inexact (ensmall-prefix (enlarge-time-units (remove-prefix (list tyme prefix unit))))))



;; Test cases:
;(convert 478234  'atto   'seconds) = (list 478234  'atto  'seconds)
;(convert .478234  'atto   'seconds) = (list 478234  'atto  'seconds)
;(convert 478234  'nano   'seconds) = (list 478.234 'micro 'seconds)
;(convert .478234  'nano   'seconds) = (list 478.234 'pico 'seconds)
;(convert 4782340 'nano   'seconds) = (list 4.78234 'milli 'seconds)
;(convert 366     'single 'days)    = (list (/ 366 365.24) 'single 'years)
(convert 1e23 'single 'seconds)                      









;;; (collect items criterion?): list-of ANY, (ANY -> boolean) --> list-of ANY
;;; Return all the elements of "items" which satisfy the function "criterion?".
;;;
;(define (collect items criterion?)
;  (if (empty? items)
;      empty
;      (if (criterion? (first items))
;          (cons (first items) (collect (rest items) criterion?))
;          (collect (rest items) criterion?))))
;
;; Test:
;(collect (list 3 8 7 6 5 1 4) even?) = (list 8 6 4)