5.1
5.2
(define (f1 x y) (sentence (butfirst x) (butlast y))) (define (f2 x y) (sentence (butfirst x) (butlast y) (word (first x) (last y)))) (define (f3 x y) (sentence x x)) (define (f4 x y) (word (first (butfirst x)) (first (butfirst y))))5.9
5.19
(define (insert-and x) (sentence (butlast x) 'and (last x))) (insert-and '(john bill wayne fred joey)) ;(john bill wayne fred and joey)
6.7
;;; return the "type" of its argument, one of WORD, SENTENCE, NUMBER, BOOLEAN (define (type-of x) (cond ((number? x) 'number) ((or (equal? x '#t) (equal? x '#f)) 'boolean) ((sentence? x) 'sentence) ((word? x) 'word) (else 'something-else)))
7.1
7.2
keep every first every last accumulate word every last every accumulate7.4
(define (choose-beatles pred) (keep pred '(john paul ringo george))) ;;; test cases (choose-beatles number?) ;() (choose-beatles word?) ;(john paul ringo george)7.8
(define (exaggerate-word w) (cond ((number? w) (* w 2)) ((equal? w 'good) 'great) ((equal? w 'bad) 'terrible) ((equal? w 'beat) 'crushed) ((equal? w 'one) 'two) ((equal? w 'two) 'four) ((equal? w 'ate) 'snarfed) (else w))) (define (exaggerate sen) (every exaggerate-word sen)) ;;; test cases (exaggerate '()) ;() (exaggerate '(i ate 2 bad potstickers)) ;(i snarfed 4 terrible potstickers) ;;; oops, english is more complicated than our program! (exaggerate '(i missed the record by only 2 seconds)) ;'(i missed the record by only 4 seconds))7.10
;;; Two different definitions.
;;; This one is really cool:
(define (true-for-all? pred sen)
(equal? (keep pres sen) sen))
;;; This is "brute force", but looks more efficient:
(define (true-for-all? pred sen)
(or (empty? sen)
(and (pred (first sen))
(true-for-all? pred (butfirst sen)))))
;;; test cases
(true-for-all? number? '(1 2 3)) ; #t
(true-for-all? number? '()) ; #t
(true-for-all? number? '(1 two 3)) ; #f
7.11
(define (gpa sen)
(/ (accumulate + (every grade-val sen))
(count sen)))
(define (grade-val x)
(+ (base-grade x) (grade-modifier x)))
(define (base-grade x)
(cond ((equal? (first x) 'a) 4)
((equal? (first x) 'b) 3)
((equal? (first x) 'c) 2)
((equal? (first x) 'd) 1)
((equal? (first x) 'f) 0)
(else (error "strange grade"))))
(define (grade-modifier x)
(cond ((equal? (last x) '+) 0.33)
((equal? (last x) '-) -0.33)
(else 0)))
7.13(define (phone-unspell w) (accumulate word (every letter->digit w))) (define (letter->digit l) (cond ((member? l '(a b c)) 2) ((member? l '(d e f)) 3) ((member? l '(g h i)) 4) ((member? l '(j k l)) 5) ((member? l '(m n o)) 6) ((member? l '(p r s)) 7) ((member? l '(t u v)) 8) ((member? l '(w x y)) 9) (else (error "unknown letter has no digit"))))
8.1
8.2
(define second (lambda (stuff) (first (bf stuff)))) (define make-adder (lambda (num) (lambda (x) (+ num x))))8.3
The procedure let-it-be is the same as last. It returns the last element of the sentence or word it is passed.
8.4
(define (prepend-every prefix sen) (every (lambda (w) (word prefix w)) sen))8.7
(define (hang w guessed) (accumulate word (every (lambda (l) (if (member? l guessed) l '_)) w)))8.10
(define (unabbrev sen codebook) (every (lambda (w) (if (number? w) (item w codebook) w)) sen))8.12
(define (compose f g) (lambda (x) (f (g x))))8.15
(define (aplize f)
(lambda (x)
(if (sentence? x) (every f x) (f x))))
12.2
;;; WRONG
(define (acronym sent)
(if (= (count sent) 1)
(first sent)
(word (first (first sent))
(acronym (bf sent)))))
;;; FIXED
(define (acronym sent)
(if (= (count sent) 1)
(first (first sent)) ;first letter of first word
(word (first (first sent))
(acronym (bf sent)))))
12.5
;;; We use the same helper function EXAGGERATE-WORD as in 7.8 above
(define (exaggerate sen)
(if (empty? sen)
'()
(sentence (exaggerate-word (first sen))
(exaggerate sen))))
12.8
(define (numbers sen)
(if (empty? sen)
'()
(sentence (if (number? (first sen))
(first sen)
'())
(numbers (butfirst sen)))))
12.11
(define (count x)
(if (or (equal? x '())
(equal? x ""))
0
(+ 1 (count (butfirst x)))))
;;; Here is a cute higher-order definition (not allowed here but I
;;; think it's neat.)
(define (count x)
(accumulate + (every (lambda (x) 1) x)))
12.13 (extra credit)
;;; This was a fun one.
;;; The solution here tries to be modular by separating knowlege about:
;;; - words for different amounts of time
;;; - how to pluralize a word
;;; - how long different things are (eg years are not really 52 weeks,
;;; and there are leap seconds, and all that stuff)
(define (describe-time sec)
(describe-time-aux
sec
'(century year week day hour minute second)
(sentence (* 60 60 24 7 52 100) ; seconds in a century
(* 60 60 24 7 52) ; seconds in a year
(* 60 60 24 7) ; seconds in a week
(* 60 60 24) ; seconds in a day
(* 60 60) ; seconds in an hour
60 ; seconds in a minute
1))) ; seconds in a second
(define (describe-time-aux sec terms lengths)
(cond ((or (empty? terms) (zero? sec)) '())
((< sec (first lengths))
(describe-time-aux sec
(butfirst terms)
(butfirst lengths)))
(else
(sentence (inexact->exact ; get "xxx.0" -> xxx
(floor (/ sec (first lengths))))
(maybe-pluralize (first terms)
(floor (/ sec (first lengths))))
(describe-time-aux (- sec
(* (first lengths)
(floor (/ sec (first lengths)))))
(butfirst terms)
(butfirst lengths))))))
;;; Return first arg in gramatical form appropriate for given count.
(define (maybe-pluralize x n)
(if (= n 1) x (pluralize x)))
;;; This is a gross oversimplification of the rules of English:
(define (pluralize x)
(if (and (equal? (last x) 'y)
(not (equal? x 'day)))
(word (butlast x) 'ies)
(word x 's)))
;;; test cases
(describe-time (* 60 60))
;(1 hour)
(describe-time (+ (* 48 60 60) (* 60 60)))
;(2 days 1 hour)
(describe-time 75384937894663)
;(23970 centuries 7 years 43 weeks 6 days 6 hours 17 minutes 43 seconds)
(describe-time 0)
;()
They should do the exact same thing the predifined procedures without the my- prefix do, and they should be defined using recursion, and without calling any higher order procedures. (They only have to work when the second argument is a sentence: don't go to any trouble to make them work when the second argument is a word.)
For extra credit define my-repeated as well.
;;; Plain Jane recursion:
(define (my-keep f x)
(cond ((empty? x) '())
((f (first x))
(sentence (first x) (my-keep f (butfirst x))))
(else
(my-keep f (butfirst x)))))
;;; Cute cheating definition:
(define (my-keep f x)
(every (lambda (y) (if (f y) y '())) x))
;;; This is the hardest one:
(define (my-accumulate f x)
(cond ((empty? x)
;; instead of this:
;; (error "can't accumulate nothing")
;; Let the function run on zero args and good luck.
;; This should work for +, *, word, sentence.
;; Others will get error.
(f))
((empty? (butfirst x))
;; This is an act of faith, but usually right.
;; Wrong for eg F=SENTENCE, ah well.
;; If we could check if F could take single arg
(first x))
((empty? (butfirst (butfirst x)))
;; Normal base case: length of two
(f (first x) (first (butfirst x))))
(else
;; Length > 2, returse
(f (first x)
(my-accumulate f (butfirst x))))))
;;; plain jane recursive definition:
(define (my-every f x)
(if (empty? x)
'()
(sentence (f (first x))
(my-every f (butfirst x)))))
(circle-sentence-and-add '(1 1 1 1 100 50 1 2 3))puts up a picture like this:
Hint: use a helper function of two arguments that does all the work.
;;; There are a whole bunch of different ways to do this one. ;;; Here is the one I thought of first: (define (circle-sentence-and-add s) (circle-sentence-and-add-aux s 0)) (define (circle-sentence-and-add-aux s total) (write total) (cond ((not (empty? s)) (move 50) (turn 10) (circle-sentence-and-add-aux (butfirst s) (+ total (first s)))))) ;;; Another possibility is to use the CIRCLE-SENTENCE from PS2 as a ;;; subroutine, and a helper function to calculate running totals ;;; of a sentence.