Exam 3: Sophisticated Scheming

Topics: List recursion, higher-order procedures, encapsulating control.

As you may recall, we began our investigation of recursion by considering how we might step through a list of numbers, adding them (or multiplying them or ...). Here are variants of the two versions we wrote:

One uses simple recursion.

(define sum-right
  (lambda (numbers)
     (if (null? (cdr numbers))
         (car numbers)
         (+ (car numbers) (sum-right (cdr numbers))))))

The other uses a helper to accumulate the results.

(define sum-left
  (lambda (numbers)
    (let kernel ((so-far (car numbers))
                 (remaining (cdr numbers)))
      (if (null? remaining)
          so-far
          (kernel (+ so-far (car remaining)) 
                  (cdr remaining))))))

If you think carefully about it, the two processes compute results slightly differently. Given the list (n0 n1 n2 n3 n4), the first computes

(+ n0 (+ n1 (+ n2 (+ n3 n4))))

while the second computes

(+ (+ (+ (+ n0 n1) n2) n3) n4)

For addition, this doesn't make a difference. If the operation were subtraction, it would certainly make a difference.

The process of combining a list of values using a binary procedure is quite common. We've seen it for addition, subtraction, and multiplication. We might also use it for appending strings and many other operations. Computer scientists have various names for such a process. We'll call it fold, but others use inject (as in “inject this operation into this list”) or reduce (as in, “reduce this list to a single value”).

(proc v0 (proc v1 (proc v2 (... (proc vn-1  vn) ... ))))

> (fold-right + (list 1 2 3 4))
10
> (fold-right * (list 1 2 3 4))
24
> (fold-right - (list 1 2 3 4))
-2
> (fold-right (lambda (s1 s2) (string-append s1 ", " s2)) (list "sentient" "malicious" "powerful" "stupid"))
"sentient, malicious, powerful, stupid"
> (fold-right list (list 'a 'b 'c 'd 'e))
(a (b (c (d e))))

(proc (proc ... (proc (proc v0 v1) v2) ... vn-1) vn)

> (fold-left + (list 1 2 3 4))
10
> (fold-left * (list 1 2 3 4))
24
> (fold-left - (list 1 2 3 4))
-8
> (fold-left (lambda (s1 s2) (string-append s1 ", " s2)) (list "sentient" "malicious" "powerful" "stupid"))
"sentient, malicious, powerful, stupid"
> (fold-left list (list 'a 'b 'c 'd 'e))
((((a b) c) d) e)

Topics: Deep recursion, pair structures, predicates.

You have written a predicate color-tree? in the lab on trees that determines whether every leaf in a tree is a color. Generalize this idea by writing the predicate (tree-all? pred? tree), which indicates whether the predicate pred? is satisfied for all leaves in tree.

For example,

> (tree-all? number? (cons (cons (cons 1 2) (cons 3 4)) (cons 5 (cons 6 7))))
#t
> (tree-all? even? (cons (cons (cons 1 2) (cons 3 4)) (cons 5 (cons 6 7))))
#f
> (tree-all? char? (cons (cons #\a #\b) #\c))
#t
> (tree-all? char? (cons (cons #\a #\b) "c"))
#f
> (tree-all? odd? 1)
#t
> (tree-all? char? 1)
#f

Topics: Higher-order procedures, searching, files.

Write, but do not document, a procedure, (file-search filename pred?), that searches the specified file for the first value that matches pred?. For example, if the file contains the values

12
1
23
152
6

then we might see the following results.

> (file-search "sample-file" odd?)
1
> (file-search "sample-file" (lambda (x) (> x 100)))
152
> (file-search "sample-file" (lambda (x) (< x 0)))
#f
> (file-search "sample-file" string?)
#f

Topics: Strings, numeric recursion.

As you may recall, (substring str start finish) extracts a substring from str that runs from position start to position finish-1. The string-length procedure lets you find the length of a string.

Write, but do not document, a procedure, (all-substrings str len), that generates a list of all the substrings of str of length len. For example,

> (all-substrings "television" 3)
("tel" "ele" "lev" "evi" "vis" "isi" "sio" "ion")

Topics: Unit testing, numeric recursion, strings.

When a procedure passes a series of tests, can you be certain the procedure is implemented correctly? Unfortunately not. Consider the following procedure and test suite.

;;; Procedure:
;;;   string-trim
;;; Parameters:
;;;   str, a string
;;; Purpose:
;;;   Remove leading and trailing whitespace from a string.
;;; Produces:
;;;   trimmed, a string
;;; Preconditions:
;;;   No additional.
;;; Postconditions:
;;;   trimmed is a substring of str, which can be obtained by
;;;     (substring str start end) for some values of start and end.
;;;   (string-ref str start) is not a whitespace character.
;;;   (string-ref str end) is not a whitespace character. 
;;;   For all i, 0 <= i < start, (string-ref str i) is a whitespace character.
;;;   For all j, end < j < (string-length str), (string-ref str j) is a whitespace character.
;;;   Note that if str consists only of whitespace, then trimmed should be "".
(define string-trim
  (lambda (str)
    (letrec ((find-first-non-whitespace 
              (lambda (start end)
                (cond ((= start end) start)
                      ((not (char-whitespace? (string-ref str start))) start)
                      (else (find-first-non-whitespace (+ start 1) end)))))
             (find-last-non-whitespace
              (lambda (start end)
                (cond ((= end start) end)
                      ((not (char-whitespace? (string-ref str end))) (+ end 1))
                      (else (find-last-non-whitespace start (- end 1)))))))
      (let ((start (find-first-non-whitespace 1 (- (string-length str) 1)))
            (end (find-last-non-whitespace 1 (- (string-length str) 1))))
        (substring str start end)))))

(begin-tests!)
(test! (string-trim "   spacey   ") "spacey")
(test! (string-trim "\ttabs\t\t") "tabs")
(test! (string-trim "\nnewlines!\n") "newlines!")
(test! (string-trim " spaces in the middle ") "spaces in the middle") 
(test! (string-trim "  ") "")
(end-tests!)

Although the procedure passes the given tests, it is not correctly implemented. Write additional tests that reveal the bugs in the procedure. That is, write tests that the procedure fails, but that it would pass if it were implemented correctly according to the documentation.

Hint: You should be able to find at least one case where the procedure call fails because of an error, and at least one case where the procedure returns an incorrect result.

Topics: Higher-order programming, map, apply, conciseness.

A very useful mathematical identity is the fact that the log of the product of numbers is equal to the sum of the log of the numbers. You may have seen the special case for two numbers, log(a*b) = log(a) + log(b), but this generalizes to any number of values. In the following, you will use the built-in Scheme procedure log.

Topics: Sectioning, composition, characters, strings.

On the previous exam, you wrote a set of procedures for ROT13, a specific kind of Caesar substitution cipher. Presumably, you wrote a set of support procedures not unlike the following.

(define shift-down
 (lambda (x) (- x 65)))

(define add-13
 (lambda (x) (+ 13 x)))

(define wrap-26
 (lambda (x) (mod x 26)))

(define shift-up
 (lambda (x) (+ 65 x)))

You used these to write char-rot13. In this problem, we will generalize this further, and strive to make our solution more concise.

> (define char-rot15 (char-caesar-encoder 15))

> (char-rot15 #\B)
#\Q
> (define char-unrot15 (char-caesar-encoder -15))

> (char-unrot15 #\Q)
#\B
> ((char-caesar-encoder 1) #\A)
#\B

> (string-caesar-encode "HELLO" 7)
"OLSSV"
> (string-caesar-encode (string-caesar-encode "WORLD" 10) -10)
"WORLD"

Topics: Colors, iterating over images, optimal values.

You may recall that in the past, we looked for the brightest colors in a list of colors. It might make more sense to look for the brightest pixel in an image. Write, but do not document, a procedure, (image-brightest-pixel image) that returns the position of the brightest pixel. The position should be a pair of the form (col . row).

Warning: This procedure may be quite slow even if correctly implemented. Test it on a very small image (e.g., 5x5 pixels) before trying it on a larger image.

For example, if square is defined as the image shown, then calling image-brightest-pixel should produce the following result.

> (image-brightest-pixel square)
(2 . 1)

In writing image-brightest-pixel, you may find the following procedure helpful.

;;; Procedure:
;;;   rgb-brightness
;;; Parameters:
;;;   color, an RGB color
;;; Purpose:
;;;   Computes the brightness of color on a 0 (dark) to 100 (light) scale.
;;; Produces:
;;;   b, an integer
;;; Preconditions:
;;;   color is a valid RGB color.  That is, each component is between
;;;     0 and 255, inclusive.
;;; Postconditions:
;;;   If color1 is likely to be perceived as lighter than color2,
;;;     then (brightness color1) > (brightness color2).
(define rgb-brightness
  (lambda (color)
    (round (* 100 (/ (+ (* 0.30 (rgb-red color))
                        (* 0.59 (rgb-green color))
                        (* 0.11 (rgb-blue color)))
                      255)))))

Write 6-P documentation for the image-brightest-pixel procedure. Hint: Think carefully about the postconditions. What does it mean for a pixel to be the brightest?

Topics: Vectors, color palettes, image-scan.

As you may know, a histogram measures the frequency of occurrence of different types of items in a set. For example, we might survey the class and produce a histogram that gives the number of first-years, second-years, juniors, and seniors, or the number of science, social studies, humanities, and other majors. Machine vision researchers (and others) are sometimes concerned with the frequency at which each color occurs in an image. Since the number of possible colors is so huge, they use a smaller palette to categorize each color in the image. In this problem, we'll use a palette to encode each pixel in an image, and count the number of times each palette index occurs.

Recall the procedure (palette-encode-color palette color), which encodes a color by returning the index of the closest color from the palette.

The function image-scan allows us to easily iterate over all the pixels of an image. The usage of the procedure is (image-scan image proc!). The procedure proc! should have the form (lambda (col row color) ...). Like its kin image-variant and image-compute, the procedure image-scan calls your procedure proc! for every pixel in the image, in this case passing to proc! the column, row, and color of the pixel.

Use image-scan and palette-encode-color to implement the procedure documented as follows.

;;; Procedure:
;;;   image-palette-histogram
;;; Parameters:
;;;   image, an image identifier
;;;   palette, a list of RGB colors
;;; Purpose:
;;;   To count the number of times each palette-encoded color is used in an image
;;; Produces:
;;;   hist, a vector
;;; Preconditions:
;;;   palette is non-null
;;; Postconditions:
;;;   The length of hist is the same as the length of palette. 
;;;   Each index in hist contains the number of times the corresponding palette 
;;;     color is used in the image.

You can copy the palette-encode-color and related procedures from here. You do not need to include them in your solution.

Hint: You will need to create a vector and use it in the body of the procedure passed to image-scan. Each time you encode a color from the image, increment the value in the vector that corresponds to the resulting index.

Some example runs are below:

> (define colors-rainbow (map color-name->rgb (list "red" "orange" "yellow" "green" "blue" "indigo" "violet")))
colors-rainbow
> (image-palette-histogram (image-load "/usr/share/pixmaps/fsview.xpm") colors-rainbow)
#(0 222 0 288 154 40 320)
> (image-palette-histogram (image-load "/usr/share/pixmaps/gnome-error.png") colors-rainbow)
#(575 182 0 1437 0 87 23)
> (image-palette-histogram (image-load "/usr/share/pixmaps/python.xpm") colors-rainbow)
#(0 227 260 471 0 472 91)