; XEmacs: This file contains -*- Scheme -*- source code.

;;; Plotting

;;; John David Stone
;;; Department of Mathematics and Computer Science
;;; Grinnell College
;;; stone@cs.grinnell.edu

;;; created May 4, 2000
;;; last revised May 16, 2000

;;; This program generates and displays, in a window, a two-dimensional
;;; plot in which the heights of some trees are plotted against their
;;; diameters.  The data displayed in the plot are taken from a survey of
;;; black cherry trees in the Allegheny National Forest in Pennsylvania.

;;; The plot contains two perpendicular coordinate axes, a horizontal
;;; one near the bottom of the window and a vertical one near its left
;;; edge, and a collection of points, one for each tree.  Coordinates
;;; along the horizontal axis represent tree diameters; the left end
;;; of that axis corresponds to the least of the tree diameters in the data
;;; set and the right end to the greatest of them.  Similarly, along the
;;; vertical axis, the bottom end corresponds to the least of the tree
;;; heights and the top end to the greatest of them.  Note that the
;;; intersection of the coordinate axes is not the point (0, 0) -- this
;;; plot is displaced from the mathematical origin so that the actual data
;;; values can be indicated more accurately.  Along each axis, tick marks
;;; and numerical labels are placed at regular intervals to guide the
;;; observer.

;;; Above and to the right of the axes are dots -- actually, small
;;; diamond-shaped marks -- indicating the heights and diameters of the
;;; trees included in the survey.

;;; PLOT-FRAME is the top-level window within which we draw the plot.  The
;;; title of the frame describes the data and identifies the units of
;;; measurement.

(define plot-frame
  (make-object frame% "Height (in feet) vs. diameter (in inches)"))

;;; PLOT-CANVAS is the drawing area inside the frame.

(define plot-canvas
  (make-object canvas% plot-frame))

;;; Every canvas has a ``device context,'' which translates drawing
;;; commands into low-level operations that the intended display device
;;; supports.  PLOT-CONTEXT is PLOT-CANVAS's device context.

(define plot-context
  (send plot-canvas get-dc))

;;; Every device context has a default font that is used when the device
;;; context is asked to draw a string.  PLOT-FONT is PLOT-CONTEXT's default
;;; font.

(define plot-font
  (send plot-context get-font))

;;; The ``height'' of a font is the distance, in pixels, between the top of
;;; the tallest character and the bottom of the deepest extender.  When a
;;; string is drawn using this font, a region of this height suffices to
;;; contain the string completely.  FONT-HEIGHT is the height of PLOT-FONT.

(define font-height
  (call-with-values
    (lambda () (send plot-context get-text-extent "dummy" plot-font))
    (lambda (width height dummy-0 dummy-1) height)))

;;; The ``width'' of a string, relative to a given font, is the distance,
;;; in pixels, between the left edge of the first character and the right
;;; edge of the last character.  When the string is drawn in the given ont,
;;; a region of this width suffices to contain the string completely.  The
;;; TEXT-WIDTH procedure computes the width of a given string in PLOT-FONT.

(define text-width
  (lambda (str)
    (call-with-values
      (lambda () (send plot-context get-text-extent str plot-font))
      (lambda (width height dummy-0 dummy-1) width))))

;;; Each of the trees that figures in the data set is represented by an
;;; object of the following class, TREE%.  A tree has three relevant
;;; properties: its diameter (in inches), its height (in feet), and its
;;; volume (in cubic feet).  Although tree volumes do not figure in the
;;; plot that we are generating, they are relevant to the program because
;;; they occur in the data file from which we are extracting the data to be
;;; plotted.

(define tree%
  (class object% (given-diameter given-height given-volume)
    (private
      (diameter given-diameter)
      (height given-height)
      (volume given-volume))
    (public
      (get-diameter (lambda () diameter))
      (get-height (lambda () height))
      (get-volume (lambda () volume)))
    (sequence
      (super-init))))

;;; TREE-FILE-NAME is the name of the file that contains the tree data.

(define tree-file-name "/usr/local/minitab/dat/trees.DAT")

;;; TREE-ROSTER is a list of trees, one tree for each line of the data
;;; file.  The data are actually read in as the definiens is evaluated --
;;; there is no separate input procedure.

(define tree-roster
  (let ((tree-source (open-input-file tree-file-name)))
    (let kernel ((peek (read tree-source)))
      (if (eof-object? peek)
          (begin
            (close-input-port tree-source)
            null)
          (let* ((diameter peek)
                 (height (read tree-source))
                 (volume (read tree-source)))
            (cons (make-object tree% diameter height volume)
                  (kernel (read tree-source))))))))

;;; We can now describe the appearance of the plot.

;;; Plots look a little cramped if one draws anything at all too close to
;;; the frame.  We leave a border or margin at each edge.  BORDER is the
;;; size of this margin, in pixels.

(define border 12)

;;; The region within which the points are plotted -- the region enclosed
;;; by the coordinate axes -- has a fixed size.  PLOT-REGION-WIDTH and
;;; PLOT-REGION-HEIGHT determine its dimensions.

(define plot-region-width 480)
(define plot-region-height 480)

;;; Tick marks appear at regular intervals on each axis.  TICK-LENGTH is
;;; the length of each tick mark, in pixels.

(define tick-length 6)

;;; In some cases, a tick mark is labeled with the value of the coordinate
;;; at that point.  A small gutter of white space separates the tick mark
;;; from the nearest edge of the label.  BETWEEN-LABEL-AND-TICK is the size
;;; of that gutter, in pixels.

(define between-label-and-tick 3)

;;; To determine how far apart the labels should be and where they should
;;; be placed, we first need to determine the least and the greatest of the
;;; values that are to be plotted along each coordinate.

(define minimum-horizontal
  (apply min (map (lambda (arbor) (send arbor get-diameter)) tree-roster)))

(define maximum-horizontal
  (apply max (map (lambda (arbor) (send arbor get-diameter)) tree-roster)))

(define minimum-vertical
  (apply min (map (lambda (arbor) (send arbor get-height)) tree-roster)))

(define maximum-vertical
  (apply max (map (lambda (arbor) (send arbor get-height)) tree-roster)))

;;; For maximum legibility, we place between four and ten labels along each
;;; axis, and twice that many tick marks (every other tick mark is
;;; labeled).  For the coordinates that receive labels, we choose
;;; successive multiples of ``round'' numbers.  We count a number as
;;; ``round,'' in this sense, if it is 1, 2, or 5 times some power of ten.

;;; Given minimum and maximum values of some coordinate, the LABEL-INTERVAL
;;; procedure computes the interval between labels, if we are to have no
;;; fewer than four labels and no more than are needed, provided that the
;;; interval is a round number.

;;; If this interval is used, no more than ten labeled coordinates fall
;;; between the minimum and maximum values, because x is no more than two
;;; and a half times the nearest round number smaller than x (the worst
;;; case occurs when x is just short of 5 times a power of ten).  Since in
;;; this case x is one-fourth of the full range, the nearest smaller round
;;; number is less than one-tenth of the full range.

(define label-interval
  (lambda (lower upper)
    (nearest-smaller-round-number (/ (- upper lower) 4))))

;;; The NEAREST-SMALLER-ROUND-NUMBER takes any positive real as argument
;;; and returns the greatest real number that is 1, 2, or 5 times a power
;;; of ten and is not greater than the argument.

;;; We determine the appropriate power of ten is by taking the base-ten
;;; logarithm of the argument, applying the floor procedure to that
;;; logarithm to eliminate its fractional part, and raising 10 to the power
;;; of the floored logarithm.  The desired round number is either 5 times
;;; that power of ten, or 2 times that power of ten, or that power of ten
;;; itself, whichever is the first that does not exceed the original
;;; argument.

(define nearest-smaller-round-number
  (lambda (guess)
    (let ((power-of-ten (expt 10 (floor (log10 guess)))))
      (let ((five-times (* 5 power-of-ten)))
        (if (<= five-times guess)
            five-times
            (let ((two-times (* 2 power-of-ten)))
              (if (<= two-times guess)
                  two-times
                  power-of-ten)))))))

;;; The base-ten logarithm of a number is its natural logarithm divided by
;;; the natural logarithm of ten.  The LOG10 procedure computes it.

(define log10
  (let ((log-of-ten (log 10)))
    (lambda (number)
      (/ (log number) log-of-ten))))

;;; At this point, since we have the minimum and maximum values of the
;;; coordinates in each direction, we can compute the interval between
;;; labels along each axis.  The intervals between tick marks are half the
;;; size of the intervals between labels.

(define between-horizontal-labels
  (label-interval minimum-horizontal maximum-horizontal))

(define between-horizontal-ticks
  (/ between-horizontal-labels 2))

(define between-vertical-labels
  (label-interval minimum-vertical maximum-vertical))

(define between-vertical-ticks
  (/ between-vertical-labels 2))

;;; The coordinate of the label or tick mark, on either axis, that is
;;; nearest the intersection of the coordinates, is the least multiple of
;;; the relevant interval that is not less than the minimum value.  The
;;; LEAST-MULTIPLE-EXCEEDING procedure takes as arguments the interval and
;;; the minimum value and computes the least multiple of the interval that
;;; is not less than the minimum value.

(define least-multiple-exceeding
  (lambda (unit lower-bound)
    (* unit (ceiling (/ lower-bound unit)))))

;;; Before we know exactly where to place the axes, we have to know how
;;; many pixels wide the labels for the vertical axis are, because we want
;;; to ensure that the vertical axis is drawn far enough to the right to
;;; accommodate those labels.  The MAXIMUM-VERTICAL-LABEL-WIDTH procedure
;;; runs through the coordinates of the labels to be printed next to the
;;; vertical axis, converting each one to a string and checking the width,
;;; in pixels, of each of those strings.  It returns the maximum of those
;;; label widths.

(define maximum-vertical-label-width
  (do ((mark (least-multiple-exceeding between-vertical-labels
                                       minimum-vertical)
             (+ mark between-vertical-labels))
       (so-far 0 (max so-far (text-width (number->string mark)))))
      ((< maximum-vertical mark) so-far)))

;;; LEFT-EDGE-OF-PLOT-REGION is the distance, in pixels, from the left edge
;;; of the canvas to the vertical axis of the plot, computed by adding the
;;; widths of all the things that occupy the space between: the border, the
;;; labels, the gutter between the labels and the ticks, and the ticks
;;; themselves.

(define left-edge-of-plot-region
  (+ border maximum-vertical-label-width between-label-and-tick tick-length))

;;; RIGHT-EDGE-OF-PLOT-REGION is the distance, in pixels, from the left
;;; edge of the canvas to the right edge of the region within which points
;;; will be plotted.

(define right-edge-of-plot-region
  (+ left-edge-of-plot-region plot-region-width))

;;; TOP-EDGE-OF-PLOT-POSITION is the distance, in pixels, from the top edge
;;; of the canvas to the top edge of the region within which points will be
;;; plotted.

(define top-edge-of-plot-region border)

;;; BOTTOM-EDGE-OF-PLOT-REGION is the distance, in pixels, from the top
;;; edge of the canvas to the bottom edge of the region within which points
;;; will be plotted.

(define bottom-edge-of-plot-region
  (+ top-edge-of-plot-region plot-region-height))

;;; We are now ready to determine the dimensions of the canvas.  Its width
;;; is the sum of RIGHT-EDGE-OF-PLOT-REGION and the width of everything
;;; that occupies the space to the right of the plot region -- just the
;;; border.

(send plot-canvas min-width
      (inexact->exact (ceiling (+ right-edge-of-plot-region border))))

;;; Its height is the sum of BOTTOM-EDGE-OF-PLOT-REGION and the height of
;;; everything that occupies the space below the horizontal axis: tick
;;; marks, the space between tick marks and labels, the labels themselves,
;;; and the border.

(send plot-canvas min-height
      (inexact->exact (ceiling (+ bottom-edge-of-plot-region tick-length
                                  between-label-and-tick font-height
                                  border))))

;;; The canvas's size is constant, whatever happens to the window that
;;; contains it.

(send plot-canvas stretchable-width #f)
(send plot-canvas stretchable-height #f)

;;; Now that we know how big the canvas is, we can display it.

(send plot-frame show #t)

;;; We draw the vertical and horizontal axes.

(send plot-context draw-line
      left-edge-of-plot-region top-edge-of-plot-region
      left-edge-of-plot-region bottom-edge-of-plot-region)
(send plot-context draw-line
      left-edge-of-plot-region bottom-edge-of-plot-region
      right-edge-of-plot-region bottom-edge-of-plot-region)

;;; The data values and the label and tick intervals and positions computed
;;; above are all measured in the original units -- inches for the
;;; diameters of the trees, feet for their heights.  To place these
;;; correctly onto the canvas, we have to convert from data coordinates
;;; to canvas coordinates (as measured in pixels from the left or top edge
;;; of the canvas).

;;; The RESCALER procedure takes the minimum and maximum values of a
;;; collection of data, as expressed in the original units, and the minimum
;;; and maximum values of the same data as expressed in new units (such
;;; as canvas coordinates), and returns a procedure that translates any
;;; value in the original range into the corresponding, correctly scaled
;;; value in the new range.

(define rescaler
  (lambda (old-lower old-upper new-lower new-upper)
    (let ((old-range (- old-upper old-lower))
          (new-range (- new-upper new-lower)))
      (lambda (mark)
        (+ new-lower (* new-range (/ (- mark old-lower) old-range)))))))

;;; SCALE-HORIZONTAL and SCALE-VERTICAL are the particular rescaling
;;; procedures that produce horizontal and vertical canvas coordinates,
;;; respectively.

(define scale-horizontal
  (rescaler minimum-horizontal maximum-horizontal left-edge-of-plot-region
            right-edge-of-plot-region)) 

(define scale-vertical
  (rescaler minimum-vertical maximum-vertical bottom-edge-of-plot-region
            top-edge-of-plot-region))

;;; We place the tick marks on the horizontal axis.

(do ((tick (least-multiple-exceeding between-horizontal-ticks
                                     minimum-horizontal)
           (+ tick between-horizontal-ticks)))
    ((< maximum-horizontal tick))
  (let ((coordinate (scale-horizontal tick)))
    (send plot-context draw-line coordinate bottom-edge-of-plot-region
          coordinate (+ bottom-edge-of-plot-region tick-length))))

;;; We place the tick marks on the vertical axis.

(do ((tick (least-multiple-exceeding between-vertical-ticks minimum-vertical)
           (+ tick between-vertical-ticks)))
    ((< maximum-vertical tick))
  (let ((coordinate (scale-vertical tick)))
    (send plot-context draw-line left-edge-of-plot-region coordinate
          (- left-edge-of-plot-region tick-length) coordinate)))

;;; We place the labels on the horizontal axis.

(do ((mark (least-multiple-exceeding between-horizontal-labels
                                     minimum-horizontal)
           (+ mark between-horizontal-labels)))
    ((< maximum-horizontal mark))
  (let ((coordinate (scale-horizontal mark))
        (text (number->string mark)))
    (send plot-context draw-text text
          (- coordinate (/ (text-width text) 2))
          (+ bottom-edge-of-plot-region
             tick-length
             between-label-and-tick))))

;;; We place the labels on the vertical axis.

(do ((mark (least-multiple-exceeding between-vertical-labels minimum-vertical)
           (+ mark between-vertical-labels)))
    ((< maximum-vertical mark))
  (let ((coordinate (scale-vertical mark))
        (text (number->string mark)))
    (send plot-context draw-text text
          (- left-edge-of-plot-region tick-length
             between-label-and-tick (text-width text))
          (- coordinate (/ font-height 2)))))

;;; Each of the trees is represented graphically by a diamond-shaped mark
;;; five pixels high and five wide:
;;;
;;;                                  *
;;;                                 ***
;;;                                *****
;;;                                 ***
;;;                                  *
;;;
;;; The canvas coordinates of the center pixel of the diamond are the
;;; rescaled equivalents of the diameter and height of the tree.

;;; The DRAW-DIAMOND procedure turns on the pixels making up a diamond
;;; centered at given coordinates.

(define draw-diamond
  (lambda (x-coordinate y-coordinate)
    (send plot-context draw-point x-coordinate (- y-coordinate 2))
    (send plot-context draw-point (- x-coordinate 1) (- y-coordinate 1))
    (send plot-context draw-point x-coordinate (- y-coordinate 1))
    (send plot-context draw-point (+ x-coordinate 1) (- y-coordinate 1))
    (send plot-context draw-point (- x-coordinate 2) y-coordinate)
    (send plot-context draw-point (- x-coordinate 1) y-coordinate)
    (send plot-context draw-point x-coordinate y-coordinate)
    (send plot-context draw-point (+ x-coordinate 1) y-coordinate)
    (send plot-context draw-point (+ x-coordinate 2) y-coordinate)
    (send plot-context draw-point (- x-coordinate 1) (+ y-coordinate 1))
    (send plot-context draw-point x-coordinate (+ y-coordinate 1))
    (send plot-context draw-point (+ x-coordinate 1) (+ y-coordinate 1))
    (send plot-context draw-point x-coordinate (+ y-coordinate 2))))

;;; We plot each tree.

(for-each (lambda (arbor)
            (draw-diamond (scale-horizontal (send arbor get-diameter))
                          (scale-vertical (send arbor get-height))))
          tree-roster)