Problem Set 4 Answers, CS 257

(define (gertrude wd)
  (se (if (vowel? (first wd)) 'an 'a)
      wd
      'is
      (if (vowel? (first wd)) 'an 'a)
      wd
      'is
      (if (vowel? (first wd)) 'an 'a)
      wd))

;;; This is what the book wanted:

(define (gertrude wd)
  (let ((article (if (vowel? (first wd)) 'an 'a)))
    (se article wd 'is article wd 'is article wd)))

;;; but it might be reasonable to share even more:

(define (gertrude wd)
  (let ((article (if (vowel? (first wd)) 'an 'a)))
    (let ((phrase (se article wd)))
      (se phrase 'is phrase 'is phrase))))

;;; This doesn't work:

(define (superlative adjective WORD)
  (se (WORD adjective 'est) WORD))

;;; ... because the WORD formal parameter is shadowing the global
;;; variable WORD which is bound to the usual word-making function.
;;; To fix it we rename:

(define (superlative adjective WD)
  (se (WORD adjective 'est) WD))

(define (countdown n)
  (if (zero? n)
      '(blastoff)
      (se n (countdown (- n 1)))))

;;; Here is the routine that could use let.  I'm going overboard here.

(define (describe-time-aux sec terms lengths)
  (if (empty? terms)
      '()
      (let ((this-unit (first lengths)))
	(let ((this-unit-count (floor (/ sec this-unit))))
	  (se (if (zero? this-unit-count)
		  '()
		  (se
		   ;; use inexact->exact to get "xxx.0" -> xxx
		   (inexact->exact this-unit-count)
		   (maybe-pluralize (first terms)
				    this-unit-count)))
	      (describe-time-aux (- sec (* this-unit this-unit-count))
				 (bf terms)
				 (bf lengths)))))))

14.6

(define (member? wd sen)
  (and (not (empty? sen))
       (or (equal? wd (first sen))
           (member? wd (bf sen)))))

(define (differences sen)
  (if (or (empty? sen)
          (empty? (bf sen)))
      '()
      (se (- (first (bf sen)) (first sen))
          (differences (bf sen)))))

(define (expand sen)
  (cond ((empty? sen) '())
        ((number? (first sen))
         (se (rep-word (first (bf sen))
                       (first sen))
             (expand (bf (bf sen)))))
        (else (se (first sen)
                  (expand (bf sen))))))

(define (rep-word wd n)
  (if (= n 0)
      '()
      (se wd (stutter wd (- n 1)))))

(define (remove-adjacent-duplicates sen)
  (cond ((empty? sen) '())
        ((or (empty? (bf sen))
             (not (equal? (first sen) (first (bf sen)))))
         (se (first sen)
             (remove-adjacent-duplicates (bf sen))))
        (else (remove-adjacent-duplicates (bf sen)))))

(define (same-shape s1 s2)
  (or (and (empty? s1)
           (empty? s2))
      (and (not (empty? s1))
           (not (empty? s2))
           (= (count (first s1))
              (count (first s2)))
           (same-shape (bf s1) (bf s2)))))

;;; Or more succinctly:

(define (same-shape s1 s2)
  (if (empty? s1)
      (empty? s2)
      (and (not (empty? s2))
           (= (count (first s1))
              (count (first s2)))
           (same-shape (bf s1) (bf s2)))))

(define (merge s1 s2)
  (cond ((empty? s1) s2)
        ((empty? s2) s1)
        ((< (first s1) (first s2))
         (se (first s1) (merge (bf s1) s2)))
        (else
         (se (first s2) (merge s1 (bf s2))))))