### Section 7

Problem 1 (Solution):
; A Document-Summary is one of
; (make-letter Symbol Symbol Symbol)
; (make-memo Symbol Symbol Symbol Symbol)
; (make-resume Symbol Symbol Boolean)

(define-struct letter (to date signature))
(define-struct memo (from to date subject))
(define-struct resume (name date sent?))

;;from : Document-Summary -> Symbol
;; - return who the document is from
(define (from a-doc)
(cond
[(letter? a-doc) (letter-signature a-doc)]
[(memo? a-doc) (memo-from a-doc)]
[(resume? a-doc) (resume-name a-doc)]))

#|TESTS|#
(from (make-letter 'Mike 'Feb-14 'Kate))
"should be" 'Kate
(from (make-memo 'Chris 'Jean 'Jan-22 'Budget))
"should be" 'Chris
(from (make-resume 'Tara 'May-1 false))
"should be" 'Tara

Problem 2 (Solution):
; A 3dshape is one of
; (make-cube Number)
; (make-prism Number Number Number)
; (make-sphere Number)

(define-struct cube (edge))
(define-struct prism (length width height))

;;volume: 3dshape -> Number
; return volume of shape
(define (volume a-3dshape)
(cond
[(cube? a-3dshape) (expt (cube-edge a-3dshape) 3)]
[(prism? a-3dshape) (* (prism-length a-3dshape)
(prism-width a-3dshape)
(prism-height a-3dshape))]
[(sphere? a-3dshape)
(* 4/3 pi (expt (sphere-radius a-3dshape) 3))]))

#| TESTS |#
(volume (make-cube 2))
"should be" 8
(volume (make-prism 2 3 4))
"should be" 24
(volume (make-sphere 2))
"should be" (* 4/3 8 pi)

Problem 3 (Solution):
; A train is one of
; (make-commuter Number Number Boolean)
; (make-amtrak Number Number Symbol)
; (make-subway Number Number Symbol)

(define-struct commuter (cars ppc allstops?))
(define-struct amtrak (cars ppc type))
(define-struct subway (cars ppc color))

;;capacity : Train -> Number
; - return passenger capacity of train
(define (capacity a-train)
(cond
[(commuter? a-train)
(* (commuter-cars a-train) (commuter-ppc a-train))]
[(amtrak? a-train)
(* (amtrak-cars a-train) (amtrak-ppc a-train))]
[(subway? a-train)
(* (subway-cars a-train) (subway-ppc a-train))]))

;;hold-all? : Train Number -> Boolean
; - return true if train will hold number of passengers,
; false otherwise
(define (hold-all? a-train passengers)
(<= passengers (capacity a-train)))

#| TESTS |#
(capacity (make-commuter 10 20 true))
"should be" 200
(capacity (make-amtrak 30 30 'Limited))
"should be" 900
(capacity (make-subway 15 40 'blue))
"should be" 600

(hold-all? (make-commuter 10 60 false) 600)
"should be" true
(hold-all? (make-amtrak 15 40 true) 200)
"should be" true
(hold-all? (make-subway 10 35 'red) 351)
"should be" false

Problem 4 (Solution):
;An employee is one of
; (make-principal Number Number Symbol)
; (make-teacher Number Number Symbol)
; (make-assistant Number Number Symbol)

(define-struct principal (salary office degree))
(define-struct teacher (salary classroom degree))
(define-struct assistant (wage hours degree))

;tax : Employee Number -> Number
; - compute social security tax for employee
(define (tax an-emp rate)
(cond
[(principal? an-emp) (* (principal-salary an-emp) rate)]
[(teacher? an-emp) (* (teacher-salary an-emp) rate)]
[(assistant? an-emp) (* (assistant-wage an-emp)
(assistant-hours an-emp)
rate)]))

#| TESTS |#
(tax (make-principal 100000 201 'MS) .075)
"should be" 7500
(tax (make-teacher 50000 222 'BS) .15)
"should be" 7500
(tax (make-assistant 25 40 'Diploma) .10)
"should be" 100

Problem 5 (Solution):
; An Account is one of
; (make-checking Number Number)
; (make-savings Number Number)
; (make-credit Number Number Number)

; A Response is one of
; - Account
; - 'Error

(define-struct checking (balance trans))
(define-struct savings (balance trans))
(define-struct credit (balance limit trans))

;withdrawal: Account Number -> Response
; - process a withdrawal request and return an updated account or 'Error
(define (withdrawal acct amt)
(cond
[(checking? acct)
(cond
[(< (- (checking-balance acct) amt) -1000)
'Error]
[else
(make-checking
(- (checking-balance acct) amt)
(+ (checking-trans acct) 1))])]
[(savings? acct)
(cond
[(< (- (savings-balance acct) amt) 0)
'Error]
[else
(make-savings
(- (savings-balance acct) amt)
(+ (savings-trans acct) 1))])]
[(credit? acct)
(cond
[(< (credit-limit acct) (+ (credit-balance acct) amt))
'Error]
[else
(make-credit
(+ (credit-balance acct) amt)
(credit-limit acct)
(+ (credit-trans acct) 1))])]))

#| TESTS |#

(withdrawal (make-savings 10 10) 10)
"should be" (make-savings 0 11)
(withdrawal (make-savings 20 1) 21)
"should be" 'Error

(withdrawal (make-checking -999 10) 1)
"should be" (make-checking -1000 11)
(withdrawal (make-checking -999 10) 2)
"should be" 'Error

(withdrawal (make-credit 10 1000 1) 990)
"should be" (make-credit 1000 1000 2)
(withdrawal (make-credit 1000 1000 2) 1)
"should be" 'Error

 Jamie Raymond Matthias Felleisen 23 september 2002