HW9: Palettes and Efficiency

In the reading and lab on palettes, we considered the use of list-based palettes to let us store images using smaller files (at the cost of some inaccuracy in the stored image). In the reading on vectors, we started to consider how vector-based palettes would let us load images faster. In this assignment, you will write procedures to load images using both list-based and vector-based palettes, and compare the speed of the two methods.

To be able to accurately reproduce an image using the palette approach, the file must contain not only a color index for each pixel, but also the list of colors that make up the palette. Here is an example of such a file:

3 
0 0 0 
128 128 128 
255 255 255
4 4
0 0 0 1 0 0 1 2 0 1 2 2 1 2 2 2

Here's what's going on in this file:

What should the image look like? 0 corresponds to black, 1 to grey, and 2 to white. We should expect to see that the upper left of the image is black, the lower right is white, and there is a grey line dividing the two. Try drawing the image on paper to see.

a. Copy the sample data above into a new file and save the file as sample.pal.

b. Copy and paste the supporting code at the end of this assignment into DrFu.

c. If you already have a list of colors to use as a palette, here is code to save an image using that palette. (You may have written similar procedures for the lab on palettes.) Copy and paste this code into DrFu. Read it and make sure you understand what is going on.

;;; Procedure:
;;;   rgb-list-write
;;; Parameters:
;;;   colors, a list of RGB colors
;;;   outport, an output port
;;; Purpose:
;;;   Writes the elements of colors to outport.
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   outport is open for writing
;;; Postconditions:
;;;   The file associated with outport now contains all the colors in
;;;   colors.
(define rgb-list-write
  (lambda (colors outport)
    (foreach! (lambda (color) (rgb-write color outport))
              colors)))

;;; Procedure:
;;;   palette-save-image
;;; Parameters:
;;;   palette, a list of rgb colors
;;;   image, an image
;;;   filename, a string
;;; Purpose:
;;;   Save the image using the palette to represent colors in the image.
;;; Produces:
;;;   [Nothing; called for the side effect.]
;;; Preconditions:
;;;   filename is a valid file name.
;;;   palette contains only rgb colors.
;;;   palette-encode-color, int-write, and rgb-write are defined.
;;; Postconditions:
;;;   The file now contains a sequence of integers as follows:
;;;     the number of colors in the palette,
;;;     a representation for each color in the palette as produced by rgb-write,
;;;     the width and height of the image,
;;;     and an index representing the color of each pixel in the image.
(define palette-save-image
  (lambda (palette image filename)
    (let ((port (open-output-file filename))
          (width (image-width image))
          (height (image-height image)))
      ; Write the number of colors in the palette.
      (int-write (length palette) port)
      ; Write the colors in the palette.
      (rgb-list-write palette port)
      ; Write the width and height of the image.
      (int-write width port)
      (int-write height port)
      ; Write the pixel data.
      (let kernel ((col 0)
                   (row 0))
        (cond
          ((>= row height)
           (close-output-port port)
           image)
          ((>= col width)
           (kernel 0 (+ row 1)))
          (else
           (int-write (palette-encode-color palette
                                            (image-get-pixel image col row))
                      port)
           (kernel (+ col 1) row)))))))

d. Use palette-save-image to save a very small (e.g., 8 pixel by 10 pixel) image of your choice, using a small palette of your choice (such as rainbow-plus from the lab on palettes). Verify that the file produced is similar to the example given in the preliminaries above. (The whitespace and newlines will be different.)

You may have noticed that we have had you work with very small images throughout the labs and assignments on storing image data in files. There are two reasons for this. First, small image files are easier for you to read and verify they are correct (or at least reasonable). Second, our procedures for reading and writing image data have thus far been very slow.

This slowness is in part due to the time it takes to write small bits of data to a remote disk. But it is also due in part to the time required to get and set pixel colors using image-get-pixel and image-set-pixel!. These procedures hide several steps having to do with GIMP's internal representation and management of images: They must obtain a reference to the top layer of the image, tell GIMP that an editing operation is about to begin so that it can prepare the appropriate data structures, do the actual get or set, and then tell GIMP that the editing operation is over so that it can replace the old data with the new data. All this takes time.

It's much faster if we obtain the top layer, tell GIMP once that we are going to begin editing, do all of our sets and gets, and then tell GIMP we are done. Three procedures you've used before, image-variant, image-transform!, and image-compute-pixels! encapsulate this strategy. These procedures let you modify all the pixels in an image much faster than you could by writing a procedure that does numeric recursion over the column and row.

Let's consider the use of similar procedures to help us write and read pixmaps more quickly. The procedure (image-scan-region image proc left top width height) lets us iterate over all the pixels in an image, left to right and top to bottom, and learn the color corresponding to each position in the image.

For example, if canvas is a very small image, the following code should display on the screen the color corresponding to each row and column.

  (image-scan-region canvas 
                     (lambda (col row color)
                       (display "col:")
                       (display col)
                       (display " row:")
                       (display row)
                       (display " color:")
                       (display (rgb->string color))
                       (newline))
                     0 0 
                     (image-width canvas) (image-height canvas))

a. Using a small image of your choice, verify that the positions and colors are printed out, row by row, and that the original image is unchanged. Make sure you understand the parameters to image-scan-region.

Now, consider how we can use this procedure to help us write pixmaps more quickly. Rather than doing numeric recursion over the row and the column, we will use image-scan-region. Here, we will be focusing our original, rgb-colors-as-components representation. You will write a version using palettes as part of the assignment.

;;; Procedure:
;;;   image-write-pixmap-faster
;;; Parameters:
;;;   image, an image
;;;   filename, a string
;;; Purpose:
;;;   Writes the pixmap information on image to the file.
;;; Produces:
;;;   [Nothing; Called for the side effect.]
;;; Preconditions:
;;;   filename is a valid file name.
;;; Postconditions:
;;;   The file named by filename now contains a sequence of integers,
;;;   one for each RGB color in image.
(define image-write-pixmap-faster
  (lambda (image filename)
    (let ((width (image-width image))
          (height (image-height image))
          (port (open-output-file filename)))
      (int-write width port)
      (int-write height port)
      (image-scan-region image 
                         (lambda (col row color) (rgb-write color port))
                         0 0 width height)
      (close-output-port port)
      image)))

b. Use image-write-pixmap-faster to save a very small (e.g., 8 pixel by 10 pixel) image of your choice. Open the file and verify that it contains the data you expect (up to some differences in whitespace). Is it indeed faster than our original image-write-pixmap procedure?

Finally, we would also like to read pixmaps faster as well. This is where encapsulating our interactions with the image really speeds things up a lot. We'll make use of another new procedure, (image-iterate-region! image proc left top width height). image-iterate-region! is similar to image-compute-pixels! except for two differences: First, proc takes the column and row as separate parameters. Second, image-iterate-region! is guaranteed to iterate over the image row-by-row, from left to right and top to bottom, which image-compute-pixels! is not.

c. Based on what you just read, what do you expect the following code to do?

  (image-iterate-region! canvas
                         (lambda (col row)
                           (rgb-new (* col 20) 0 (* row 20)))
                         0 0 (image-width canvas) (image-height canvas))

d. Test the code and verify that it worked as you predicted.

Now, let's consider how to use image-iterate-region! to read image data into a new image. We'll start with image-read-pixmap, and replace the recursive kernel with a call to image-iterate-region!.

;;; Procedure:
;;;   image-read-pixmap-faster
;;; Parameters:
;;;   filename, a string
;;; Purpose:
;;;   Read pixmap data from the specified file, returning a new
;;;   image from that data.
;;; Produces:
;;;   image, an image.
;;; Preconditions:
;;;   filename names a file.
;;;   That file was created by image-write-pixmap.
;;; Postconditions:
;;;   image contains the same colors in the same positions as the image 
;;;   previously written with image-write-pixmap.
(define image-read-pixmap-faster
  (lambda (filename)
    (let* ((port (open-input-file filename))
           (width (int-read port))
           (height (int-read port))
           (image (image-new width height)))
      ; Read the pixel data.
      (image-iterate-region! 
       image
       (lambda (col row)
         (let ((next-color (rgb-read port)))
           (cond ((eof-object? next-color)
                  (close-input-port port)
                  (throw "image-read-pixmap!: Premature end of file."))
                 (else next-color))))
       0 0 width height)
      ; When the image is full, clean up the file.
      (let ((next-color (rgb-read port)))
        (close-input-port port)
        (if (not (eof-object? next-color))
            (throw "image-read-pixmap!: Data remain in file after image was competely read")))
      ; Return the new image.
      image)))

e. Use image-read-pixmap-faster to read back the pixmap file you wrote in step c above. Is it indeed faster than our original image-read-pixmap procedure?

Warning: During this assignment you may see errors similar to error: set-input-port: needs one argument. When you read and write larger files, as you will in this assignment, you are much more likely to see such errors. These errors are unpredictable, and we don't know where in the bowels of DrFu they are coming from. They are not your fault, and we apologize. The solution, crazy as it is, is just to try again.

> (image-show (palette-load-image "sample.pal")) 

;;; Procedure:
;;;   rgb-list-read
;;; Parameters:
;;;   source, an input port
;;;   n, a non-negative integer
;;; Purpose:
;;;   Reads n RGB colors from source, returning them as a list.
;;; Produces:
;;;   colors, a list of RGB colors
;;; Preconditions:
;;;   source is open for reading
;;; Postconditions:
;;;   colors contains the first n colors in source.
(define rgb-list-read
  (lambda (source n)
     (if (> n 0)
         (cons (rgb-read source)
               (rgb-list-read source (- n 1)))
         null)))

/home/davisjan/csc/151/samples/palettes/flowers-2.pal
/home/davisjan/csc/151/samples/palettes/flowers-4.pal
/home/davisjan/csc/151/samples/palettes/flowers-8.pal
/home/davisjan/csc/151/samples/palettes/flowers-16.pal
/home/davisjan/csc/151/samples/palettes/flowers-32.pal
/home/davisjan/csc/151/samples/palettes/flowers-64.pal
/home/davisjan/csc/151/samples/palettes/flowers-128.pal
/home/davisjan/csc/151/samples/palettes/flowers-255.pal

Our primary considerations will be the correctness of your code (that is, can it successfully load .pal files using the required techniques?) and the clarity with which you present your findings from Problem 3. Our secondary concerns will be the elegance and conciseness of your solutions.

; +------------------------+------------------------------------------
; | Palette-Based Encoding |
; +------------------------+

;;; Procedure:
;;;   palette-encode-color
;;; Parameters:
;;;   palette, a nonempty list of RGB colors
;;;   color, an RGB color
;;; Purpose:
;;;   Determine a number that appropriately encodes color using
;;;   the given palette.
;;; Produces:
;;;   encoding, an integer
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   0 <= encoding < (length palette)
;;;   (rgb-distance color (list-ref palette encoding)) <=
;;;     (rgb-distance color (list-ref palette i))
;;;     for all i, 0 <= i < (length palette)
(define palette-encode-color
  (lambda (palette color)
    (list-index-of palette (rgb-closest color palette))))
 
;;; Procedure:
;;;   palette-decode-color
;;; Parameters:
;;;   palette, a nonempty list of RGB colors
;;;   code, an integer
;;; Purpose:
;;;   Converts an encoding (created by palette-encode-color) back
;;;   to a color.
;;; Produces:
;;;   color, an RGB color
;;; Preconditions:
;;;   0 <= code < (length palette)
;;;   code was created with (rgb-encode palette some-color)
;;; Postconditions:
;;;   color is close to some-color
(define palette-decode-color
  (lambda (palette code)
    (list-ref palette code)))

;;; Procedure:
;;;   image-sample-colors
;;; Parameters:
;;;   image, an image
;;;   n, an integer
;;; Purpose:
;;;   Grabs a sample of n colors from image.
;;; Produces:
;;;   colors, a list of colors
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   Every color in colors appears somewhere in image.
;;;   (length colors) = n
(define image-sample-colors
  (lambda (image n)
    (let* ((width (image-width image))
           (height (image-height image))
	   (stride (/ (* width height) n)))
      (let kernel ((col 0)
                   (row 0)
                   (count 0)
                   (colors null))
        (cond
          ; If we've gone beyond the last row, we're done, so return 
          ; the accumulated list of colors
          ((> row (- height 1))
           colors)
          ; If the column is beyond the last column, we need to move on
          ; to a new row. 
          ((> col (- width 1))
           (kernel (- col width) (+ row 1) count colors))
          ; Okay, we have a position somewhere in the image.  Grab the color
          ; and go on to the next position.
          (else
           (kernel (+ col stride)
                   row
                   (+ count 1)
                   (cons (image-get-pixel image col row) colors))))))))

; +---------------------+---------------------------------------------
; +---------------------+---------------------------------------------
; | Reading and Writing |
; +---------------------+

;;; Procedure:
;;;   rgb-write
;;; Parameters:
;;;   color, an rgb color
;;;   port, the port to which to write the color
;;; Purpose:
;;;   Write the color to the specified port
;;; Preconditions:
;;;   port is open for writing.
;;; Postconditions:
;;;   When read with rgb-read, the data just appended to the file
;;;   will give color.

(define rgb-write
  (lambda (color port)
    (int-write (rgb-red color) port)
    (int-write (rgb-green color) port)
    (int-write (rgb-blue color) port)))

;;; Procedure:
;;;   rgb-read
;;; Parameters:
;;;   port, the name of an input port
;;; Purpose:
;;;   Reads an RGB color from the file.
;;; Produces:
;;;   color, an RGB color (or <eof>, if the port is at the end of
;;;     the file)
;;; Preconditions:
;;;   port is open for reading.
;;;   port is at the place in a file after which the next data was
;;;     written by rgb-write.
;;; Postconditions:
;;;   color is the color written by the call to rgb-write mentioned
;;;     in the preconditions.

(define rgb-read
  (lambda (port)
    (let* ((red (int-read port))
           (green (int-read port))
           (blue (int-read port)))
       (if (eof-object? blue) 
           blue
           (rgb-new red green blue)))))

(define int-write
  (lambda (int port)
    (write int port)
    (display " " port)))

(define int-read 
  (lambda (port)
    (read port)))

; +-------------------------+-----------------------------------------
; | Miscellaneous Utilities |
; +-------------------------+

;;; Procedure:
;;;   rgb-distance
;;; Parameters:
;;;   c1, an RGB color
;;;   c2, an RGB color
;;; Purpose:
;;;   Compute a "distance" between c1 and c2 that tells us how
;;;   well c1 estimates c2 (or vice versa).
;;; Produces:
;;;   distance, a real number
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   For any color c,
;;;     (rgb-distance c c) is 0 
;;;   If d is likely to be perceived as closer to c than e is to c, then
;;;     (rgb-distance c d) < (rgb-distance c e)
(define rgb-distance
  (lambda (c1 c2)
    (+ (square (- (rgb-red c1) (rgb-red c2)))
       (square (- (rgb-green c1) (rgb-green c2)))
       (square (- (rgb-blue c1) (rgb-blue c2))))))

;;; Procedure:
;;;   rgb-closer
;;; Parameters:
;;;   color, an RGB color
;;;   estimate1, an RGB color
;;;   estimate2, an RGB color
;;; Purpose:
;;;   Determines which of estimate1 and estimate2 is closer to color.
;;; Produces:
;;;   closer, an RGB color
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   closer is either estimate1 or estimate2
;;;   (rgb-distance color closer) <= (rgb-distance color estimate1)
;;;   (rgb-distance color closer) <= (rgb-distance color estimate2)
(define rgb-closer
  (lambda (color estimate1 estimate2)
    (if (<= (rgb-distance color estimate1) (rgb-distance color estimate2))
        estimate1
        estimate2)))

;;; Procedure:
;;;   rgb-closest
;;; Parameters:
;;;   color, an RGB color
;;;   colors, a list of RGB colors
;;; Purpose:
;;;   Determine the element of colors that is closest to
;;;   color
;;; Produces:
;;;   closest, an RGB color
;;; Preconditions:
;;;   colors is nonempty.
;;; Postconditions:
;;;   closest is an element of colors.
;;;   (rgb-distance color closest) <= (rgb-distance color c)
;;;     for all c in colors
(define rgb-closest
  (lambda (color colors)
    (let kernel ((remaining-colors (cdr colors))
                 (closest-so-far (car colors)))
      (if (null? remaining-colors)
          closest-so-far
          (kernel (cdr remaining-colors)
                  (rgb-closer color closest-so-far (car remaining-colors)))))))

;;; Procedure:
;;;   list-index-of
;;; Parameters:
;;;   lst, a list of values
;;;   val, a value
;;; Purpose:
;;;   Find an index of val in lst.
;;; Produces:
;;;   index, a number (or #f)
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   If there exists a value in lst equal to val, then
;;;     (list-ref lst index) equals val
;;;   If no such value exists, then
;;;     index is #f
(define list-index-of
  (lambda (lst val)
    (cond
      ((null? lst)
       #f)
      ((equal? val (car lst))
       0)
      (else
       (+ 1 (list-index-of (cdr lst) val))))))