#lang racket

;; symbols this module provides
;; The main unicalc code can only refer to definitions
;;   in this file if they appear in a "provide" expression.
(provide unicalc-db)
(provide UDB)
(provide make-QL get-quant get-num get-den)
(provide make-UQL get-error)
(provide extend-db)

;; The Unicalc database is an association list of pairs.
;; Each pair consists of a unit and a quantity defining the unit.
;; Units are atoms.
;; Quantities are 3-lists: numeric multiplier, numerator, denominator
;; Both numerator and denominator are lists of units.
;; It is assumed that they do not have any units in common and are sorted
;; '(i.e. they are already simplified, in the sense of the Unicalc application).

;; comparing symbols alphabetically requires conv. to strings
(define (sym<? sym1 sym2)
  (string<? (symbol->string sym1) (symbol->string sym2)))

;; a function for sorting lists of symbols: sortsym
(define (sortsym L) (sort L sym<?))

;; A new datastructure: the UncertainQuantity.  It is a list of three elements 
;; The first element in the list is a list containing the quantity and the error.
;; The second element is a list of the units in the numerator
;; The third element is a list of the units in the denominator
(define (make-QL quant num den)
  (list 'QL (list quant 0) num den))

(define (make-UQL quant err num den)
  (list 'UQL (list quant err) num den))

;; get-quant
;; input: a QL or UQL
;; output: the quantity part of the quantity list
;; Can handle either the old QL representation or the new UQL one
(define get-quant 
  (lambda (x) 
    (if (list? (second x))
        (first (second x))
        (second x))))

;; get-error
;; input: a QL or UQL
;; output: the error part of the quantity list (0 for a QL)
;; Can handle either the old QL representation or the new UQL one
(define get-error 
  (lambda (x) 
    (if (list? (second x))
        (second (second x))
        0)))

; Get the numerator and denominator (respectively) of the 
; input QL or UQL
(define get-num third)
(define get-den fourth)

;; Define database db for Unicalc
;; by Robert Keller
(define unicalc-db 
  (list 
(list 'A                      (make-QL 1.0 '(ampere) '()))
(list 'amp                    (make-QL 1.0 '(ampere) '()))
(list 'amu                    (make-QL 1.0 '(atomic_mass_unit) '()))
(list 'atomic_mass_unit       (make-QL 1.0 '(dalton) '()))
(list 'AU                     (make-QL 1.0 '(astronomical_unit) '()))
(list 'bbl                    (make-QL 1.0 '(barrel) '()))
(list 'C                      (make-QL 1.0 '(coulomb) '()))
(list 'c                      (make-QL 1.0 '(speed_of_light) '()))
(list 'cal                    (make-QL 1.0 '(calorie) '()))
(list 'cd                     (make-QL 1.0 '(candela) '()))
(list 'cm                     (make-QL 1.0 '(centimeter) '()))
(list 'ev                     (make-QL 1.0 '(electron_volt) '()))
(list 'feet                   (make-QL 1.0 '(foot) '()))
(list 'fl_oz                  (make-QL 1.0 '(fluid_ounce) '()))
(list 'ft                     (make-QL 1.0 '(foot) '()))
(list 'F                      (make-QL 1.0 '(farad) '()))
(list 'gev                    (make-QL 1.0e9 '(ev) '()))
(list 'g                      (make-QL 1.0 '(gram) '()))
(list 'G                      (make-QL 1.0 '(gravitational_constant) '()))
(list 'h                      (make-QL 1.0 '(Planck_constant) '()))
(list 'hp                     (make-QL 1.0 '(horsepower) '()))
(list 'hr                     (make-QL 1.0 '(hour) '()))
(list 'H                      (make-QL 1.0 '(henry) '()))
(list 'Hz                     (make-QL 1.0 '(hertz) '()))
(list 'hertz                  (make-QL 1.0 '() '(second)))
(list 'in                     (make-QL 1.0 '(inch) '()))
(list 'inches                 (make-QL 1.0 '(inch) '()))
(list 'J                      (make-QL 1.0 '(joule) '()))
(list 'kilogram               (make-QL 1.0 '(kg) '()))
(list 'kilometer              (make-QL 1000.0 '(meter) '()))
(list 'kilowatt               (make-QL 1000.0 '(watt) '()))
(list 'km                     (make-QL 1.0 '(kilometer) '()))
(list 'kph                    (make-QL 1.0 '(kilometer) '(hour)))
(list 'kwh                    (make-QL 1.0 '(hour kilowatt) '()))
(list 'l                      (make-QL 1.0 '(liter) '()))
(list 'lb                     (make-QL 1.0 '(pound) '()))
(list 'litre                  (make-QL 1.0 '(liter) '()))
(list 'lm                     (make-QL 1.0 '(lumen) '()))
(list 'lx                     (make-QL 1.0 '(lux) '()))
(list 'm                      (make-QL 1.0 '(meter) '()))
(list 'megohm                 (make-QL 1000000.0 '(ohm) '()))
(list 'metre                  (make-QL 1.0 '(meter) '()))
(list 'mev                    (make-QL 1000000.0 '(electron_volt) '()))
(list 'mho                    (make-QL 1.0 '(siemens) '()))
(list 'microhm                (make-QL 1.0e-6 '(ohm) '()))
(list 'millimeter             (make-QL (/ 1.0 1000000) '(meter) '()))
(list 'millisecond            (make-QL (/ 1.0 1000000) '(second) '()))
(list 'min                    (make-QL 1.0 '(minute) '()))
(list 'mol                    (make-QL 1.0 '(mole) '()))
(list 'mm                     (make-QL 1.0 '(millimeter) '()))
(list 'mph                    (make-QL 1.0 '(mile) '(hour)))
(list 'ms                     (make-QL 1.0 '(millisecond) '()))
(list 'N                      (make-QL 1.0 '(newton) '()))
(list 'qt                     (make-QL 1.0 '(quart) '()))
(list 'pc                     (make-QL 1.0 '(parsec) '()))
(list 'pi                     (make-QL 3.14159265358979323846 '() '()))
(list 'psi                    (make-QL 1.0 '(pound_force) '(inch inch)))
(list 'pt                     (make-QL 1.0 '(pint) '()))
(list 'rpm                    (make-QL 1.0 '(revolution) '(minute)))
(list 'S                      (make-QL 1.0 '(siemens) '()))
(list 's                      (make-QL 1.0 '(second) '()))
(list 'sec                    (make-QL 1.0 '(second) '()))
(list 'tbsp                   (make-QL 1.0 '(tablespoon) '()))
(list 'tsp                    (make-QL 1.0 '(teaspoon) '()))
(list 'T                      (make-QL 1.0 '(tesla) '()))
(list 'us                     (make-QL 1.0 '(microsecond) '()))
(list 'V                      (make-QL 1.0 '(volt) '()))
(list 'W                      (make-QL 1.0 '(watt) '()))
(list 'Wb                     (make-QL 1.0 '(weber) '()))
(list 'yd                     (make-QL 1.0 '(yard) '()))
(list 'yr                     (make-QL 1.0 '(year) '()))
(list 'acre                   (make-QL 43560.0 '(foot foot) '()))
(list 'apoth_dram             (make-QL 60.0 '(grain) '()))
(list 'apoth_ounce            (make-QL 480.0 '(grain) '()))
(list 'apoth_pound            (make-QL 5760.0 '(grain) '()))
(list 'are                    (make-QL 100.0 '(meter meter) '()))
(list 'angstrom               (make-QL 0.0000000001 '(meter) '()))
(list 'astronomical_unit      (make-QL 149600000000.0 '(meter) '()))
(list 'atmosphere             (make-QL 1013250.0 '(pascal) '()))
(list 'bar                    (make-QL 100000.0 '(pascal) '()))
(list 'barn                   (make-QL 1.0e-28 '(meter meter) '()))
(list 'barrel                 (make-QL 31.5 '(gallon) '()))
(list 'baryl                  (make-QL 1.0 '(dyne) '(centimeter centimeter)))
(list 'baud                   (make-QL 1.0 '(bit) '(second)))
(list 'bolt                   (make-QL 40.0 '(yard) '()))
(list 'british_gallon         (make-QL 1.20095 '(gallon) '()))
(list 'btu                    (make-QL 1055.06 '(joule) '()))
(list 'bucket                 (make-QL 18180.0 '(centimeter centimeter centimeter) '()))
(list 'bushel                 (make-QL 4.0 '(peck) '()))
(list 'byte                   (make-QL 8.0 '(bit) '()))
(list 'cable                  (make-QL 720.0 '(foot) '()))
(list 'carat                  (make-QL 200.0 '(milligram) '()))
(list 'caliber                (make-QL 0.001 '(inch) '()))
(list 'calorie                (make-QL 4.1868 '(joule) '()))
(list 'candle                 (make-QL 1.0 '(candela) '()))
(list 'centare                (make-QL 0.01 '(are) '()))
(list 'centimeter             (make-QL 0.01 '(meter) '()))
(list 'century                (make-QL 10.0 '(decade) '()))
(list 'chain                  (make-QL 66.0 '(foot) '()))
(list 'chronon                (make-QL 1.0e-24 '(second) '()))
(list 'coulomb                (make-QL 1.0 '(ampere second) '()))
(list 'cup                    (make-QL 0.5 '(pint) '()))
(list 'curie                  (make-QL 3.7037e10 '(becquerel) '()))
(list 'dalton                 (make-QL 1.6605654e-24 '(gram) '()))
(list 'daraf                  (make-QL 1.0 '() '(farad)))
(list 'day                    (make-QL 24.0 '(hour) '()))
(list 'decade                 (make-QL 10.0 '(year) '()))
(list 'degree                 (make-QL 0.005555555555555556 '(pi radian) '()))
(list 'dozen                  (make-QL 12.0 '() '()))
(list 'dram                   (make-QL 0.00390625 '(pound) '()))
(list 'dry_barrel             (make-QL 105.0 '(dry_quart) '()))
(list 'dry_pint               (make-QL 0.5 '(dry_quart) '()))
(list 'dry_quart              (make-QL 67.2 '(inch inch inch) '()))
(list 'dyne                   (make-QL 0.00001 '(newton) '()))
(list 'electron_volt          (make-QL 1.60218925e-20 '(joule) '()))
(list 'ell                    (make-QL 45.0 '(inch) '()))
(list 'em                     (make-QL 0.167 '(inch) '()))
(list 'en                     (make-QL 0.5 '(em) '()))
(list 'erg                    (make-QL 0.000001 '(joule) '()))
(list 'faraday                (make-QL 96490.0 '(coulomb) '()))
(list 'farad                  (make-QL 1.0 '(coulomb) '(volt)))
(list 'fathom                 (make-QL 6.0 '(foot) '()))
(list 'fermi                  (make-QL 1.0e-15 '(meter) '()))
(list 'fluid_dram             (make-QL 0.125 '(fluid_ounce) '()))
(list 'fluid_ounce            (make-QL 0.125 '(cup) '()))
(list 'flux_unit              (make-QL 1.0e-26 '(second watt) '(meter meter)))
(list 'foot                   (make-QL 12.0 '(inch) '()))
(list 'fortnight              (make-QL 2.0 '(week) '()))
(list 'free_acceleration      (make-QL 9.80665 '(meter) '(second second)))
(list 'furlong                (make-QL 40.0 '(rod) '()))
(list 'gallon                 (make-QL 231.0 '(inch inch inch) '()))
(list 'gauss                  (make-QL 0.0001 '(tesla) '()))
(list 'gilbert                (make-QL 1.0 '(ampere turn) '()))
(list 'gill                   (make-QL 0.25 '(pint) '()))
(list 'grain                  (make-QL 0.000142857 '(pound) '()))
(list 'gram                   (make-QL 0.001 '(kg) '()))
(list 'grav                   (make-QL 1.0 '(free_acceleration) '()))
(list 'gravitational_constant (make-QL 6.67259e-11 '(meter meter newton) '(kg kg)))
(list 'gross                  (make-QL 12.0 '(dozen) '()))
(list 'hectare                (make-QL 100.0 '(acre) '()))
(list 'henry                  (make-QL 1.0 '() '(ampere)))
(list 'hand                   (make-QL 4.0 '(inch) '()))
(list 'hogshead               (make-QL 63.0 '(gallon) '()))
(list 'horsepower             (make-QL 550.0 '(foot pound_force) '(second)))
(list 'hour                   (make-QL 60.0 '(minute) '()))
(list 'inch                   (make-QL 0.0254 '(meter) '()))
(list 'joule                  (make-QL 1.0 '(kg meter meter) '(second second)))
(list 'kilogram_force         (make-QL 1.0 '(free_acceleration kg) '()))
(list 'knot                   (make-QL 1.0 '(nautical_mile) '(hour)))
(list 'lambert                (make-QL 3.142 '(candela) '(centimeter centimeter)))
(list 'league                 (make-QL 3.0 '(mile) '()))
(list 'light_year             (make-QL 9406910000000000.0 '(meter) '()))
(list 'link                   (make-QL 7.92 '(inch) '()))
(list 'liter                  (make-QL 1000.0 '(centimeter centimeter centimeter) '()))
(list 'long_ton               (make-QL 2240.0 '(pound) '()))
(list 'lumen                  (make-QL 1.0 '(candela steradian) '()))
(list 'lux                    (make-QL 1.0 '(lumen) '(meter meter)))
(list 'maxwell                (make-QL 0.00000001 '(weber) '()))
(list 'metric_ton             (make-QL 1000.0 '(kg) '()))
(list 'micron                 (make-QL 0.000001 '(meter) '()))
(list 'mil                    (make-QL 0.001 '(inch) '()))
(list 'mile                   (make-QL 8.0 '(furlong) '()))
(list 'millenium              (make-QL 10.0 '(century) '()))
(list 'minute                 (make-QL 60.0 '(second) '()))
(list 'mole                   (make-QL 6.02253e23 '() '()))
(list 'nautical_mile          (make-QL 1.15078 '(mile) '()))
(list 'newton                 (make-QL 1.0 '(joule) '(meter)))
(list 'ohm                    (make-QL 1.0 '(volt) '(ampere)))
(list 'oil_barrel             (make-QL 42.0 '(gallon) '()))
(list 'ounce                  (make-QL 0.0625 '(pound) '()))
(list 'parsec                 (make-QL 30856770000000000 '(meter) '()))
(list 'pascal                 (make-QL 1.0 '(newton) '(meter meter)))
(list 'Planck_constant        (make-QL 6.626076e-34 '(joule second) '()))
(list 'peck                   (make-QL 8.0 '(dry_quart) '()))
(list 'pennyweight            (make-QL 24.0 '(grain) '()))
(list 'pica                   (make-QL 12.0 '(point) '()))
(list 'pint                   (make-QL 0.5 '(quart) '()))
(list 'point                  (make-QL 0.013837 '(inch) '()))
(list 'poise                  (make-QL 0.1 '(pascal) '(second)))
(list 'pound                  (make-QL 0.45359237 '(kg) '()))
(list 'pound_force            (make-QL 1.0 '(free_acceleration pound) '()))
(list 'poundal                (make-QL 1.0 '(foot pound) '(second second)))
(list 'quadrant               (make-QL 90.0 '(degree) '()))
(list 'quart                  (make-QL 0.25 '(gallon) '()))
(list 'revolution             (make-QL 4.0 '(quadrant) '()))
(list 'reyn                   (make-QL 68947.6 '(poise) '()))
(list 'rod                    (make-QL 16.5 '(foot) '()))
(list 'rood                   (make-QL 0.25 '(acre) '()))
(list 'rope                   (make-QL 20.0 '(foot) '()))
(list 'scruple                (make-QL 20.0 '(grain) '()))
(list 'section                (make-QL 1.0 '(mile mile) '()))
(list 'siemens                (make-QL 1.0 '(ampere) '(volt)))
(list 'skein                  (make-QL 360.0 '(foot) '()))
(list 'slug                   (make-QL 32.1740 '(pound) '()))
(list 'span                   (make-QL 9.0 '(inch) '()))
(list 'speed_of_light         (make-QL 299792458.0 '(meter) '(second)))
(list 'stadion                (make-QL 622.0 '(foot) '()))
(list 'stadium                (make-QL 202.0 '(yard) '()))
(list 'stokes                 (make-QL 0.0001 '(meter meter) '(second)))
(list 'survey_mile            (make-QL 320.0 '(rod) '()))
(list 'tablespoon             (make-QL 0.5 '(fluid_ounce) '()))
(list 'teaspoon               (make-QL (/ 1.0 3) '(tablespoon) '()))
(list 'tesla                  (make-QL 1.0 '(weber) '(meter meter)))
(list 'therm                  (make-QL 1.0e5 '(btu) '()))
(list 'ton                    (make-QL 2000.0 '(pound) '()))
(list 'torr                   (make-QL 0.001315789473684210526 '(atmosphere) '()))
(list 'township               (make-QL 36.0 '(section) '()))
(list 'troy_ounce             (make-QL 20.0 '(pennyweight) '()))
(list 'troy_pound             (make-QL 12.0 '(troy_ounce) '()))
(list 'volt                   (make-QL 1.0 '(joule) '(coulomb)))
(list 'watt                   (make-QL 1.0 '(joule) '(second)))
(list 'weber                  (make-QL 1.0 '(volt) '(second)))
(list 'week                   (make-QL 7.0 '(day) '()))
(list 'yard                   (make-QL 3.0 '(foot) '()))
(list 'year                   (make-QL 365.25 '(day) '()))
))


;; a shorter name for us lazy folks!
(define UDB unicalc-db)

;; Function to add new pairs to the database.

(define (extend-db new-unit new-QL)
  (set! unicalc-db (cons (list new-unit new-QL) unicalc-db))
  (set! UDB unicalc-db)
)