;; Caltech CS 1 Fall 2007
;; Scheme code for lecture 11 (11/05/2007)
;; mvanier@cs.caltech.edu
;; Page 1 of 4

;; Quoting.
(quote a) ;; --> a
'a        ;; --> a
(quote (a . b)) ;; --> (a . b)
'(a . b)  ;; --> (a . b)
(quote (a b c d e)) ;; --> (a b c d e)
'(a b c d e)  ;; --> (a b c d e)
'()           ;; Empty list (nil)

;; Test for symbol equality:
(eq? 'a 'a)   ;; #t
(eq? 'a 'b)   ;; #f
(eq? 'a 10)   ;; #f

;; Revising result abstraction

(define (make-named-result x y researcher) 
  (list x y researcher))
(define (get-x result) (car result))
(define (get-y result) (car (cdr result)))
;; Can also write: (define (get-y result) (cadr result))
(define (who result) (car (cdr (cdr result))))
;; Can also write: (define (who result) (caddr result))

(define (not-bitdiddle? result)
  (not (eq? (who result) 'bitdiddle)))

(define results
  (list (make-named-result  1   1.9  'hacker)
        (make-named-result  2   4.3  'bitdiddle)
        (make-named-result  3   6.0  'hacker)
        (make-named-result  4   7.8  'reasoner)
        (make-named-result  5  10.2  'bitdiddle))
                     

;; Caltech CS 1 Fall 2007
;; Page 2 of 4

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tagged data: adding units
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Representations for a few types of lengths:

(define (make-meter length)
  (cons 'meter length))
(define (get-tag m) (car m))
(define (get-value m) (cdr m))
(define (meter? m)
  (and (pair? m) 
       (eq? (get-tag m) 'meter)))
(define (make-foot length)
  (cons 'foot length))
(define (foot? m)
  (and (pair? m) 
       (eq? (get-tag m) 'foot)))

;; Object specific addition

(define (meter-add a b)
  (make-meter (+ (get-value a) (get-value b))))
(define (foot-add a b)
  (make-foot (+ (get-value a) (get-value b))))

;; Conversion between types

(define (feet-to-meters f)
  (let ((meters-per-foot 0.3048))
    (make-meter (* meters-per-foot 
                   (get-value f)))))

(define (meters-to-feet m) ; not on slides
  (let ((feet-per-meter 3.2808))
    (make-feet (* feet-per-meter 
                  (get-value m)))))

;; Generic length-add

(define (length-add a b)
  (cond ((and (meter? a) (meter? b)) 
         (meter-add a b))
        ((and (foot? a) (foot? b)) 
         (foot-add a b))
        ((and (foot? a) (meter? b))
         (meter-add (feet-to-meters a) b))
        ((and (meter? a) (foot? b))
         (meter-add  a (feet-to-meters b)))
        (else (error "can't add these: " a b))))


;; Caltech CS 1 Fall 2007
;; Page 3 of 4

;; Examples:

(length-add (make-meter 1) (make-meter 1))
(length-add (make-foot 1)  (make-foot 1))
(length-add (make-meter 1) (make-foot 1))

;; More constructors

(define (make-centimeter length)
  (make-meter (/ length 100)))
(define (make-inch length)
  (make-foot (/ length 12)))
(define (make-kilometer length)
  (make-meter (* 1000 length)))

;; Smart (type-aware) conversions

(define (get-meters length)
  (cond ((meter? length) length)
        ((foot?  length) (feet-to-meters length))
        (else 
         (error "get-meters requires a length, but given: " length))))

(define (get-feet length)
  (cond ((foot?  length) length)
        ((meter? length) (meters-to-feet length))
        (else 
         (error "get-feet requires a length, but given: " length))))

;; Examples

(get-meters (make-meter 1))
(get-meters (make-foot 3))
;;(get-meters 4)  --> error

;; Another add:
;;(define (length-add a b)
;;   (meter-add (get-meter a) (get-meter b)))
;; What does this return when adding feet?

;; other types / units

(define (make-gram mass) (cons 'gram mass))
(define (make-second time) (cons 'second time))
(define minutes-per-second 60)
(define (make-minute time) 
  (make-second 
   (* time minutes-per-second)))
(define (gram? m)
  (and (pair? m) (eq? 'gram (get-tag m))))
(define (second? m)
  (and (pair? m) (eq? 'second (get-tag m))))


;; Caltech CS 1 Fall 2007
;; Page 4 of 4

;; Detecting types

(define (length? a)
  (or (meter? a) (foot? a)))
(define (mass? a)
  (gram? a))
(define (time? a)
  (second? a))

(define (second-add a b)
  (make-second (+ (get-value a) (get-value b))))

(define (time-add a b)
  (cond ((and (second? a) (second? b))
		 (second-add a b))
		(else 
		 (error "incompatible types: " a b))))

;; Unit addition
;; "dispatches" on the type of a and b

(define (unit-add a b)
  (cond ((and (length? a) (length? b))
		 (length-add a b))
		((and (time? a) (time? b))
		 (time-add a b))
		((and (mass? a) (mass? b))
		 (mass-add a b))
		(else (error "incompatible units" a b))))

;; Examples:

(unit-add (make-meter 1) (make-foot 1))
(unit-add (make-second 1) (make-minute 2))
;;(unit-add (make-second 3) (make-foot 1))  <-- error!