;;; stoichiometry.ss -- determining the chemical formulas of compounds

;;; John David Stone
;;; Department of Mathematics and Computer Science
;;; Grinnell College
;;; stone@math.grin.edu

;;; created March 6, 2000
;;; last revised March 6, 2000

;;; This program prompts the user for the abbreviations and relative
;;; proportions, by weight, of two chemical elements in some sample of
;;; a compound.  It then determines and prints out the chemical formula
;;; of that compound (or at least the program's best guess).

;;; The DISPLAY-PURPOSE procedure announces to the user the nature and
;;; purpose of the interaction that the program proposes to perform.

(define display-purpose
  (lambda ()
    (display "Give me the symbols for the two elements in your sample")
    (newline)
    (display "and the amounts you found of each one, and I'll determine")
    (newline)
    (display "the chemical formula for the compound.")
    (newline)
    (newline)))

;;; ATOMIC-WEIGHTS is an association list in which the keys are the symbols
;;; of the chemical elements and the data are their atomic weights.  (I
;;; obtained these values from ``Standard atomic weights (IUPAC 1997):
;;; definition data,'' at
;;;
;;; http://www.webelements.com/webelements/properties/text/definitions/atomic-weight.html
;;;
;;; The author is Mark Winter of the University of Sheffield.)

(define atomic-weights
  (list (cons 'Ac 227)
        (cons 'Al 26.981538)
        (cons 'Am 243)
        (cons 'Sb 121.76)
        (cons 'Ar 39.948)
        (cons 'As 74.9216)
        (cons 'At 210)
        (cons 'Ba 137.327)
        (cons 'Bk 247)
        (cons 'Be 9.012182)
        (cons 'Bi 208.98038)
        (cons 'Bh 264)
        (cons 'B 10.811)
        (cons 'Br 79.904)
        (cons 'Cd 112.411)
        (cons 'Cs 132.90545)
        (cons 'Ca 40.078)
        (cons 'Cf 251)
        (cons 'C 12.0107)
        (cons 'Ce 140.116)
        (cons 'Cl 35.4527)
        (cons 'Cr 51.9961)
        (cons 'Co 58.9332)
        (cons 'Cu 63.546)
        (cons 'Cm 247)
        (cons 'Db 262)
        (cons 'Dy 162.5)
        (cons 'Es 252)
        (cons 'Er 167.26)
        (cons 'Eu 151.964)
        (cons 'Fm 257)
        (cons 'F 18.9984032)
        (cons 'Fr 223)
        (cons 'Gd 157.25)
        (cons 'Ga 69.723)
        (cons 'Ge 72.61)
        (cons 'Au 196.96655)
        (cons 'Hf 178.49)
        (cons 'Hs 269)
        (cons 'He 4.002602)
        (cons 'Ho 164.93032)
        (cons 'H 1.00794)
        (cons 'In 114.818)
        (cons 'I 126.90447)
        (cons 'Ir 192.217)
        (cons 'Fe 55.845)
        (cons 'Kr 83.8)
        (cons 'La 138.9055)
        (cons 'Lr 262)
        (cons 'Pb 207.2)
        (cons 'Li 6.941)
        (cons 'Lu 174.967)
        (cons 'Mg 24.305)
        (cons 'Mn 54.938049)
        (cons 'Mt 268)
        (cons 'Md 258)
        (cons 'Hg 200.59)
        (cons 'Mo 95.94)
        (cons 'Nd 144.24)
        (cons 'Ne 20.1797)
        (cons 'Np 237)
        (cons 'Ni 58.6934)
        (cons 'Nb 92.90638)
        (cons 'N 14.00674)
        (cons 'No 259)
        (cons 'Os 190.23)
        (cons 'O 15.9994)
        (cons 'Pd 106.42)
        (cons 'P 30.973762)
        (cons 'Pt 195.078)
        (cons 'Pu 244)
        (cons 'Po 210)
        (cons 'K 39.0983)
        (cons 'Pr 140.90765)
        (cons 'Pm 145)
        (cons 'Pa 231.03588)
        (cons 'Ra 226)
        (cons 'Rn 222)
        (cons 'Re 186.207)
        (cons 'Rh 102.9055)
        (cons 'Rb 85.4678)
        (cons 'Ru 101.07)
        (cons 'Rf 261)
        (cons 'Sm 150.36)
        (cons 'Sc 44.95591)
        (cons 'Sg 266)
        (cons 'Se 78.96)
        (cons 'Si 28.0855)
        (cons 'Ag 107.8682)
        (cons 'Na 22.98977)
        (cons 'Sr 87.62)
        (cons 'S 32.066)
        (cons 'Ta 180.9479)
        (cons 'Tc 98)
        (cons 'Te 127.6)
        (cons 'Tb 158.92534)
        (cons 'Tl 204.3833)
        (cons 'Th 232.0381)
        (cons 'Tm 168.93421)
        (cons 'Sn 118.71)
        (cons 'Ti 47.867)
        (cons 'W 183.84)
        (cons 'Uub 277)
        (cons 'Uun 269)
        (cons 'Uuu 272)
        (cons 'U 238.0289)
        (cons 'V 50.9415)
        (cons 'Xe 131.29)
        (cons 'Yb 173.04)
        (cons 'Y 88.90585)
        (cons 'Zn 65.39)
        (cons 'Zr 91.224)))

;;; The PROMPT procedure takes the text of a prompt as its argument,
;;; displays it, and collects and returns the user's reply.

(define prompt
  (lambda (prompt-text)
    (display prompt-text)
    (read)))

;;; The PROMPT-FOR-ELEMENT procedure prompts the user for a symbol that is
;;; the abbreviation for some chemical element, which it returns.  If the
;;; user supplies something that is not a symbol, or a symbol that is not
;;; the abbreviation for some chemical element, PROMPT-FOR-ELEMENT displays
;;; an advisory message and repeats the prompt.

(define prompt-for-element
  (lambda ()
    ;; You get to write this one.
  ))

;;; The PROMPT-FOR-AMOUNT procedure prompts the user for the mass (in
;;; grams) of some amount of an element, which it returns.  returns.  If
;;; the user supplies something that is not a positive real number,
;;; PROMPT-FOR-AMOUNT displays an advisory message and repeats the prompt.

(define prompt-for-amount
  (lambda ()
    (let ((candidate (prompt "Amount (in grams): ")))
      (if (and (positive? candidate)
               (real? candidate))
          candidate
          (begin
            (display "The value ")
            (write candidate)
            (display " is not a positive real number.")
            (newline)
            (display "Please supply an amount.")
            (newline)
            (prompt-for-amount))))))

;;; The COLLECT-DATA procedure prompts the user for two chemical elements
;;; and the relative amounts (by weight) of each one in a given sample.  It
;;; returns a four-element list in which the first element is the symbol
;;; for one of the chemical elements, the second is its amount, the third
;;; is the symbol for the other chemical element, and the fourth is its
;;; amount.

(define collect-data
  (lambda ()

    ;; Use LET*, rather than LET, to make sure that the prompts are
    ;; generated in the proper sequence.

    (let* ((first-element (prompt-for-element))
           (first-amount (prompt-for-amount))
           (second-element (prompt-for-element))
           (second-amount (prompt-for-amount)))
      (list first-element first-amount second-element second-amount))))

;;; The MOLE-EQUIVALENT procedure takes two arguments -- the symbol for a
;;; chemical element and the mass, in grams, of some amount of that element
;;; -- and returns the number of moles of that element present in the mass.

(define mole-equivalent
  (lambda (element amount)
    ;; This one is yours, too.  It's a one-liner, since you can look up the 
    ;; atomic weight.
  ))

;;; The FIND-RATIO procedure takes an estimate of the ratio between the
;;; numbers of atoms of two elements in a sample and returns a pair of
;;; small integers whose ratio is very close to the given estimate.

(define find-ratio
  (lambda (estimate)
    (let ((fraction (rationalize (inexact->exact estimate) 1/100)))
      (cons (numerator fraction) (denominator fraction)))))

;;; The PRINT-ELEMENT procedure takes the symbol for a chemical element as
;;; its argument and prints out that symbol, with the first character
;;; capitalized and the other characters, if any, in lower case, as is
;;; conventional in chemistry.

(define print-element
  (lambda (sym)
    (let ((str (symbol->string sym)))
      (display (char-upcase (string-ref str 0)))
      (let ((len (string-length str)))
        (let kernel ((position 1))
          (if (< position len)
              (begin
                (display (char-downcase (string-ref str position)))
                (kernel (+ position 1)))))))))

;;; The PRINT-FORMULA procedure takes four arguments, of which the first is
;;; the symbol for a chemical element, the second an integer, the third the
;;; symbol for another chemical element, and the fourth an integer, and
;;; displays the chemical formula for a molecule containing the specified
;;; number of atoms of each element.

(define print-formula
  (lambda (first-element first-count second-element second-count)
    (print-element first-element)
    (if (not (= first-count 1))    ; No subscript if the count is 1.
        (display first-count))
    (print-element second-element)
    (if (not (= second-count 1))
        (display second-count))))

;;; The DRIVER procedure collects the data from the user, performs the
;;; necessary computations, and prints out the results.

(define driver
  (lambda ()
    (display-purpose)
    (let ((data (collect-data)))
      (let ((first-element (car data))
            (first-amount (cadr data))
            (second-element (caddr data))
            (second-amount (cadddr data)))
        (let ((ratio (find-ratio (/ (mole-equivalent first-element
                                                     first-amount)
                                    (mole-equivalent second-element
                                                     second-amount)))))
          (display "The chemical formula of the sample is ")
          (print-formula first-element (car ratio)
                         second-element (cdr ratio))
          (display ".")
          (newline))))))