;; Author: Christine Alvarado
;; Sept 12, 2010
;; Time spent: long enough.

(load "unicalc-db.rkt")


;; Data abstraction for a quantity list
(define (make-QL quant num den)
  (list quant num den))

(define get-quant first)

(define get-num second)

(define get-den third)

;; function: cancel
;; Input: two lists, L and M
;; Output: A list containing the units in M 
;;     that are not in L (i.e., cancels L out of M)
(define (cancel L M)
  (cond ((null? L) M)
        ((null? M) M)
        ((string-ci<? (symbol->string (first L)) 
                      (symbol->string (first M))) (cancel (rest L) M))
        ((string-ci<? (symbol->string (first M))
                      (symbol->string (first L))) (cons (first M) (cancel L (rest M))))
        (else (cancel (rest L) (rest M)))))

;; function: simplify
;; input: A quantity list
;; output: A simplified quantity list where 
;;     units shared between the numerator and denominator
;;     have been eliminated.
(define (simplify QL)
  (make-QL (get-quant QL)
        (cancel (get-den QL) (get-num QL))
        (cancel (get-num QL) (get-den QL))))

;; function: multiply
;; input: two quantity lists.  If the inputs are normalized 
;;     then the output will be as well
;; output: the QL QL1*QL2
(define (multiply QL1 QL2)
  (simplify (make-QL (* (get-quant QL1) (get-quant QL2))
                  (sort (append (get-num QL1) (get-num QL2)) 
                        (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                                     (symbol->string s2))))
                  (sort (append (get-den QL1) (get-den QL2)) 
                        (lambda (s1 s2) 
                          (string-ci<? (symbol->string s1)
                                       (symbol->string s2)))))))

;; function: power
;; input: A quantity list QL1 and an integer p.
;; output: the QL QL1^p.  If QL1 is normalized 
;;     then the output will be as well
(define (power QL1 p)
  (cond
    ((< p 0) (power (divide (make-QL 1.0 '() '()) QL1) (* -1 p)))
    ((= p 0) (make-QL 1.0 '() '()))
    (else (multiply QL1 (power QL1 (- p 1))))))
      

;; function: divide
;; input: two quantity lists.  If the inputs are normalized 
;;     then the output will be as well
;; output: the QL QL1/QL2
(define (divide QL1 QL2)
  (simplify (make-QL (/ (get-quant QL1) (get-quant QL2))
                  (sort (append (get-num QL1) (get-den QL2)) 
                        (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                     (symbol->string s2))))
                  (sort (append (get-den QL1) (get-num QL2)) 
                        (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                     (symbol->string s2)) )))))

;; function: conv-unit
;; input: a unit, s
;; output: looks up a single unit in the database
;; and returns a QL for that unit if it is basic,
;; or the conversion entry in the database if it is not.
(define (conv-unit s)
  (cond ((assoc s unicalc-db) (second (assoc s unicalc-db)))
        (else (make-QL 1.0 (list s) ()))))

;; function: normalize-unit
;; input: a unit, s
;; output: A normalized quantity list equivalent to the 
;;   input unit.
(define (normalize-unit s)
  (cond ((not (assoc s unicalc-db)) (make-QL 1.0 (list s) '()))
        (else (normalize (conv-unit s)))))

;; function: normalize
;; input: a Quantity list
;; output: A normalized version of the input QL
(define (normalize QL)
  (cond ((null? (append (get-num QL) (get-den QL))) QL)
        ((null? (get-num QL)) (divide (make-QL (get-quant QL) '() '())
                                     (normalize (make-QL 1.0 (get-den QL) '()))))
        (else (multiply (normalize-unit (first (get-num QL)))
                        (normalize (make-QL (get-quant QL)
                                    (rest (get-num QL))
                                    (get-den QL)))))))

;; function: add
;; input: Two quantity lists.  This version does not 
;;   assume the inputs are normalized.
;; output: The QL resulting from adding the two input QLs,
;;   or an error if the QLs are not in terms of the same units.
;;   The output is always normalized.
(define (add Q1 Q2)
  (let ((norm-Q1 (normalize Q1))
        (norm-Q2 (normalize Q2)))
    (cond 
      ((units-match norm-Q1 norm-Q2) (make-QL (+ (get-quant norm-Q1) (get-quant norm-Q2)) (get-num norm-Q1) (get-den norm-Q1)))
      (else (list 'error "illegal add" Q1 Q2))))) 

;; function: subtract
;; input: Two quantity lists, QL1 and QL2  
;;   This version does not 
;;   assume the inputs are normalized.
;; output: The QL resulting from QL1-QL2,
;;   or an error if the QLs are not in terms of the same units.
;;   The output is always normalized.
(define (subtract QL1 QL2)
  (let* ((negQL2 (make-QL (* -1 (get-quant QL2)) (get-num QL2) (get-den QL2)))
         (sumQL (add QL1 negQL2)))
    (if (equal? (first sumQL) 'error)
        (list 'error "illegal subtract" QL1 QL2)
        sumQL)))

;; function: units-match
;; input: two QLs, QL1 and QL2
;; output: #t if the units in QL1 are identical to the units
;;   in QL2, #f otherwise.
(define (units-match QL1 QL2)
  (let (
        (sortedQ1num (sort (get-num QL1)
                           (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                                        (symbol->string s2)))))
        (sortedQ2num (sort (get-num QL2)
                           (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                                        (symbol->string s2)))))
        (sortedQ1den (sort (get-den QL1)
                           (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                                        (symbol->string s2)))))
        (sortedQ2den (sort (get-den QL2)
                           (lambda (s1 s2) (string-ci<? (symbol->string s1)
                                                        (symbol->string s2)))))
        )
    (and (equal? sortedQ1num sortedQ2num) (equal? sortedQ1den sortedQ2den))
    ))
 
;(load "tester.rkt") 
;(load "unicalc-tests.rkt")
(load "hw2pr1tests.rkt")