; Graph.lisp
; Quick-graphing tool for Macintosh Common Lisp. 
; by Richard S. Sutton <rich@richsutton.com>
;
; See http://rlai.cs.ualberta.ca/RLAI/graphlispmanual.html. 
;
; Verified to work on MCL 2.0, MCL 5.0 and MCL 5.1
 
;(defpackage :graph 
;  (:use :common-lisp :ccl :g)) 
 
;(in-package :graph) 
 
(defvar *graph* nil)      ; a global holds the current graph (crude)


(export '(graph graph+ graph- add-to-graph subtract-from-graph grid-graph x-graph-limits 
                y-graph-limits 
                x-tick-marks y-tick-marks choose-graph print-graph graph-data)) 
 
; A graph is a window with various state vars.  The simplest way to use this is: 
 
; (graph data)  
; and then, possibly, (graph+ data) 
 
; The graph involved defaults to the frontmost graph or a newly created graph 
; if their are no graphs yet (or if graph is t). Alternatively, you can make  
; multiple graphs, and specify the graph as a last argument to all graph routines. 
 
; Data can be a simple list of y's (heights) or a list of list of y's. 
; Or it can be a list of (x y) coordinates, e.g., ((x1 y1) (x2 y2) ...) 
; Or a list of those! 
 
; The span of the graph is initially set from the data.  Alternatively: 
;   (x-graph-limits xmin xmax) does it manually (same for y-graph-limits) 
;   (x-graph-limits) sets it back to auto 
 
; Tick marks are initially just at the min and max.  Alternatively: 
;   (x-tick-marks tick1 tick2 tick3 ...) sets them manually (same for y-tick-marks) 
;   (x-tick-marks) sets them back to auto 
; Tick marks are specified by values, e.g., (x-tick-marks 0 .5 1.0)  
; or by a list of value-label pairs, e.g., (x-tick-marks '(0 "0") '(1.0 "1")) 


(defclass graph (g-view) 
  ((data-view :accessor data-view) 
   (data :initform nil) 
   (auto-limits-x :initform t)          ; limiting x values from data,  
   (auto-limits-y :initform t)          ; or from user and tick-marks? 
   (x-max :initform 1.0) 
   (x-min :initform 0.0) 
   (y-max :initform 1.0) 
   (y-min :initform 0.0) 
   (x-tick-marks :initform nil)         ; initial tick marks auto from limits 
   (y-tick-marks :initform nil) 
   (main-color) 
   (character-style :initform '("Geneva" 9 :plain)) 
   (character-width :initform 4) 
   (character-height :initform 6) 
   (x-label-space) 
   (y-label-space) 
   (zero-space :initform 10) 
   (x-end-space :initform 50) 
   (y-end-space :initform 10) 
   (tick-length :initform t) 
   (boxy :initform nil) 
   (grid-density :initform nil) 
   (highlight-p :initform nil) 
   (highlight-color) 
   (highlight-line :initform 0)))
 
 
;; The data is a list of lists.  Each list is either a list of y-values or 
;; a list of xy-pairs. 
 
(defmethod initialize-instance ((graph graph) &key (data-view-type 'data-view)) 
  (without-event-processing 
   (call-next-method) 
   (with-slots (main-color highlight-color data-view x-label-space y-label-space character-width 
                           character-height tick-length zero-space character-style
                           x-min y-min x-max y-max) graph 
     (setq data-view (make-instance data-view-type :parent graph)) 
     (g-set-coordinate-system data-view x-min y-min x-max y-max :lower-left) 
     (setq x-label-space (gd-text-width graph "1000.00000033E+23" character-style))
     (setq y-label-space (+ 6 (gd-text-height graph "1000.33333" character-style)))
     (setq tick-length (/ zero-space 2)) 
     (setq main-color (g-color-on data-view)) 
     (setq highlight-color (g-color-pen data-view (g-color-flip data-view) nil nil 2 2)) 
     (setq *graph* graph)
     (g-accept-new-viewport-size graph))))
 
(defmethod g-accept-new-viewport-size :before ((graph graph)) 
  (g-set-cs-scale graph 0 0 1 1 :lower-left))
 
(defmethod g-accept-new-viewport-size :after ((graph graph)) 
  (when (slot-boundp graph 'data-view)
    (with-slots (x-label-space zero-space y-label-space zero-space x-end-space y-end-space 
                               data-view) graph 
      (multiple-value-bind (x1 y1 x2 y2) (g-get-coordinate-system graph) 
        (declare (ignore x1 y1)) 
        (g-set-viewport data-view 
                        (+ x-label-space zero-space) 
                        (+ y-label-space zero-space) 
                        (- x2 x-end-space) 
                        (- y2 y-end-space))) 
      (g-clear graph) 
      (g-draw-view graph))))
 
 
(defclass data-view (g-view) ()) 
 
(defun graph (new-data &optional color graph)                       ;<a name="graph"</a>[<a href="graph.html#graph">Doc</a>] 
  "Establishes some data for a graph, then draws it" 
  (if (OR (null new-data) (loop for d in new-data never d)) 
    (print "No graphing data") 
    (let () 
      (setq new-data (loop for d in new-data for n from 0 when d collect d 
                           when (null d) do (format t "~%Warning: Nth data-to-be-graphed is nil for N=~A" n))) 
      (cond ((stringp color) (setq graph color) (setq color nil)) 
            ((keywordp color) (setq color (color-from-keyword color)))) 
      (setq graph (choose-graph graph)) 
      (with-slots (data highlight-line highlight-p) graph 
        (setf data (fillin-nil-colors (regularize-data new-data color))) 
        (setq highlight-line 0) 
        (setq highlight-p nil) 
        (compute-limits-from-data graph) 
        (g-clear graph) 
        (g-draw-view graph) 
        (window-select graph)))))
 
(defun regularize-data (data color) 
  "regular form is a list of lines, each of which is a list or list of pairs, preceded by color" 
  (cond ((atom (first data))            ; simple list 
         (list (cons color data))) 
        ((listp (first (first data)))   ; list of lists of pairs 
         (loop for d in data collect (cons color d))) 
        ((= 2 (length (first data)))    ; list of pairs 
         (list (cons color data))) 
        (t                              ; list of lists 
          (loop for d in data collect (cons color d))))) 
 
(defun fillin-nil-colors (data) 
  (loop for color-line in data 
        when (null (first color-line)) 
        do (setf (first color-line) (first-unused-color data))) 
  data) 
 
(defun graph-data (&optional graph) 
  "Returns the data plotted in graph, with color stripped away of course" 
  (loop for color-line in (slot-value (choose-graph graph) 'data) 
    collect (rest color-line)))
 
(defun first-x (data) 
  "returns the x-value of the first point in data" 
  (let* ((line (loop for line in data until line finally (return line)))
         (first-point (second line))) 
    (if (not (consp first-point)) 
      1 
      (first first-point))))
                
(defun first-y (data) 
  "returns the y-value of the first point in data" 
  (let* ((line (loop for line in data until line finally (return line)))
         (first-point (second line))) 
    (if (not (consp first-point)) 
      first-point 
      (second first-point)))) 
 
(defun graph+ (new-data &optional color graph)            ;<a name="graph+"</a>[<a href="graph.html#graph+">Doc</a>] 
  (add-to-graph new-data color graph)) 
                
(defun add-to-graph (new-data &optional color graph)                  ;<a name="add-to-graph"</a>[<a href="graph.html#add-to-graph">Doc</a>] 
  "Adds additional data to a graph" 
  (if (OR (null new-data) (loop for d in new-data never d)) 
    (print "No graphing data added") 
    (let () 
      (setq new-data (loop for d in new-data for n from 0 when d collect d 
                           when (null d) do (format t "~%Warning: Nth data-to-be-graphed is nil for N=~A" n))) 
      (cond ((stringp color) (setq graph color) (setq color nil)) 
            ((keywordp color) (setq color (color-from-keyword color)))) 
      (setq graph (choose-graph graph)) 
      (with-slots (data) graph 
        (setf data (fillin-nil-colors (append data (regularize-data new-data color)))) 
        (compute-limits-from-data graph) 
        (g-clear graph) 
        (g-draw-view graph) 
        (window-select graph))))) 
 
(defun graph- (&optional color-keyword graph)            ;<a name="graph-"</a>[<a href="graph.html#graph-">Doc</a>] 
  "Remove a line of data points from the graph.  Defaults to last line" 
  (if (not color-keyword) 
    (subtract-from-graph nil graph) 
    (with-slots (data) (setq graph (choose-graph graph)) 
      (loop with remove-color = (color-from-keyword color-keyword) 
        for color-and-list in data 
        for color = (first color-and-list)
        for line-num from 0 
        when (eq color remove-color) 
        do (subtract-from-graph line-num graph) 
        (return-from graph-) 
        finally (print "No such color used in this graph"))))) 
                
(defun subtract-from-graph (&optional line-num graph)            ;<a name="subtract-from-graph"</a>[<a href="graph.html#subtract-from-graph">Doc</a>] 
  "Remove a line of data points from the graph. Line-num is from zero or defaults to last line" 
  (setq graph (choose-graph graph)) 
  (with-slots (data) graph 
    (unless line-num (setq line-num (- (length data) 1))) 
    (setf data (loop for line in data 
                 for num from 0 
                 unless (eq num line-num) collect line)) 
    (compute-limits-from-data graph) 
    (g-clear graph) 
    (g-draw-view graph) 
    (window-select graph)))
 
(defun x-graph-limits (&optional xmin xmax (graph (choose-graph)))  ;<a name="x-graph-limits"</a>[<a href="graph.html#x-graph-limits">Doc</a>] 
  (setq graph (choose-graph graph)) 
  (with-slots (auto-limits-x data-view x-min y-min x-max y-max) graph 
    (if (or xmin xmax) 
      (progn (setf auto-limits-x nil) 
             (if xmin (setf x-min xmin)) 
             (if xmax (setf x-max xmax)) 
             (g-set-coordinate-system data-view x-min y-min x-max y-max :lower-left)) 
      (progn (setf auto-limits-x t) 
             (compute-limits-from-data graph))) 
    (g-clear graph) 
    (g-draw-view graph))) 
 
(defun y-graph-limits (&optional ymin ymax (graph (choose-graph)))  ;<a name="y-graph-limits"</a>[<a href="graph.html#y-graph-limits">Doc</a>] 
  (setq graph (choose-graph graph)) 
  (with-slots (auto-limits-y data-view x-min y-min x-max y-max) graph 
    (if (or ymin ymax) 
      (progn (setf auto-limits-y nil) 
             (if ymin (setf y-min ymin)) 
             (if ymax (setf y-max ymax)) 
             (g-set-coordinate-system data-view x-min y-min x-max y-max :lower-left)) 
      (progn (setf auto-limits-y t) 
             (compute-limits-from-data graph))) 
    (g-clear graph) 
    (g-draw-view graph))) 
 
(defun x-tick-marks (&rest x-ticks)                                ;<a name="x-tick-marks"</a>[<a href="graph.html#x-tick-marks">Doc</a>] 
  "Sets the ticks marks and possibly resets limits." 
  (let ((graph (choose-graph))) 
    (with-slots (data-view x-tick-marks x-min y-min x-max y-max) graph 
      (if x-ticks  
        (progn (setf x-tick-marks (regularize-tick-marks x-ticks)) 
               (setq x-min (min x-min (min-tick-mark x-tick-marks))) 
               (setq x-max (max x-max (max-tick-mark x-tick-marks))) 
               (g-set-coordinate-system data-view x-min y-min x-max y-max :lower-left)) 
        (progn (setq x-tick-marks nil) 
               (compute-limits-from-data graph))) 
      (g-clear graph) 
      (g-draw-view graph)))) 
 
(defun y-tick-marks (&rest y-ticks)                                ;<a name="y-tick-marks"</a>[<a href="graph.html#y-tick-marks">Doc</a>] 
  "Sets the ticks marks and possibly resets limits." 
  (let ((graph (choose-graph))) 
    (with-slots (y-tick-marks) graph 
      (if y-ticks  
        (progn (setf y-tick-marks (regularize-tick-marks y-ticks)) 
               (compute-limits-from-data graph)) 
        (progn (setq y-tick-marks nil) 
               (compute-limits-from-data graph))) 
      (g-clear graph) 
      (g-draw-view graph)))) 
 
(defun regularize-tick-marks (ticks &optional (format-string "~a")) 
  (loop for tick in ticks 
        when (atom tick) collect (list tick (format nil format-string tick)) 
        else collect tick))
 
(defun min-tick-mark (ticks) 
  (let ((first (first ticks))) 
    (if (atom first) 
      first 
      (first first)))) 
 
(defun max-tick-mark (ticks) 
  (let ((last (first (last ticks)))) 
    (if (atom last) 
      last 
      (first last)))) 
 
(defmethod g-draw-view ((graph graph)) 
  "Draws the graph" 
  (with-slots (data grid-density highlight-p) graph 
    (g-clear graph)
    (draw-axes graph) 
    (loop for (color . list) in data 
          for line-num from 0 
          do (draw-line graph list color)) 
    (when highlight-p (draw-highlight graph)) 
    (if grid-density (grid-graph nil graph)))
  (g-make-visible graph))
 
(defvar colors (list (g-color-red t) 
                     (g-color-green t) 
                     (g-color-blue t) 
                     (g-color-black t) 
                     (g-color-yellow t) 
                     (g-color-pink t) 
                     (g-color-cyan t) 
                     (g-color-purple t) 
                     (g-color-magenta t) 
                     (g-color-orange t) 
                     (g-color-brown t) 
                     (g-color-light-blue t) 
                     (g-color-gray t) 
                     (g-color-dark-green t) 
                     (g-color-tan t))) 
 
(defun nth-color (n)                                      ;<a name="nth-color"</a>[<a href="graph.html#nth-color">Doc</a>] 
  (nth (mod n (length colors)) colors)) 
 
(defun color-from-keyword (color-keyword) 
  (case color-keyword 
    (:blue (g-color-blue t)) 
    (:red (g-color-red t)) 
    (:green (g-color-green t)) 
    (:black (g-color-black t)) 
    (:yellow (g-color-yellow t)) 
    (:pink (g-color-pink t)) 
    (:cyan (g-color-cyan t)) 
    (:purple (g-color-purple t)) 
    (:magenta (g-color-magenta t)) 
    (:orange (g-color-orange t)) 
    (:brown (g-color-brown t)) 
    (:light-blue (g-color-light-blue t)) 
    (:gray (g-color-gray t)) 
    (:dark-green (g-color-dark-green t)) 
    (:tan (g-color-tan t)) 
    (:white (g-color-white t)) 
    (:light-gray (g-color-light-gray t)) 
    (:dark-gray (g-color-dark-gray t)) 
    (t (error "Unrecognized color keyword: ~A" color-keyword)))) 
 
(defun first-unused-color (data) 
  "Returns first color in the list of colors that is least used in data" 
  (loop for permitted-times-used from 0 do 
        (loop for color in colors 
              when (<= (times-color-used color data) permitted-times-used) 
              do (return-from first-unused-color color)))) 
 
(defun times-color-used (color data) 
  (loop for color-and-list in data count (eq (first color-and-list) color)))
 
(defun choose-graph (&optional graph)
  "Select a graph based on input 'graph'" 
  (cond ((typep graph 'graph) 
         graph) 
        ((typep graph 'string) 
         (or (find-content-view graph 'graph)
             (make-instance 'graph :window-title graph))) 
        ((null graph) 
         (or (front-content-view :class 'graph) 
             (make-instance 'graph :window-title "Graph"))) 
        ((eq graph t) 
         (make-instance 'graph :window-title "Graph")) 
        (t (error "Can't chose graph" graph))))
    
(defun draw-axes (&optional graph) 
  (setq graph (choose-graph graph))
  (with-slots (x-label-space y-label-space data-view x-max y-max main-color) graph 
    (g-draw-line graph 
                 x-label-space y-label-space 
                 (g-convert-x data-view graph x-max) y-label-space 
                 main-color) 
    (g-draw-line graph 
                 x-label-space y-label-space 
                 x-label-space (g-convert-y data-view graph y-max) 
                 main-color) 
    (draw-tick-marks graph))) 
 
(defun draw-tick-marks (graph) 
  (with-slots (main-color x-tick-marks y-tick-marks x-label-space y-label-space  
                          data-view tick-length character-style x-min y-min x-max y-max 
                          character-width character-height) graph 
    (loop for (x label) in (or x-tick-marks (regularize-tick-marks (list x-min x-max))) 
      for gx = (g-convert-x data-view graph x) 
      when (<= x-min x x-max) 
      do 
      (g-draw-line-r graph gx y-label-space 0 tick-length main-color) 
      (g-draw-text graph label character-style 
                   (- gx -1 (/ (gd-text-width graph label character-style) 2)) 
                   (- y-label-space 4 (gd-text-height graph label character-style)) main-color)) 
    (loop for (y label) in (or y-tick-marks (regularize-tick-marks (list y-min y-max) "~a")) 
      for gy = (g-convert-y data-view graph y) 
      when (<= y-min y y-max) 
      do 
      (g-draw-line-r graph x-label-space gy tick-length 0 main-color) 
      (g-draw-text graph label character-style 
                   (- x-label-space 5 (gd-text-width graph label character-style)) 
                   (- gy (/ (gd-text-height graph label character-style) 2)) main-color))))
 
(defun draw-segment (graph x1 y1 x2 y2 color) 
  (with-slots (data-view boxy) graph 
    (if boxy 
      (progn (g-draw-line data-view x1 y1 x2 y1 color) 
             (g-draw-line data-view x2 y1 x2 y2 color)) 
      (g-draw-line data-view x1 y1 x2 y2 color)))) 
 
(defun draw (graph y-list color) 
  (loop for x1 from 1 below (length y-list) 
	for x2 from 2 upto (length y-list) 
	for y1 in y-list 
	for y2 in (cdr y-list) 
	do 
        (draw-segment graph x1 y1 x2 y2 color))) 
 
(defun draw-xy (graph xylist color) 
  (loop for (x1 y1) in xylist 
	for (x2 y2) in (cdr xylist) 
	do 
    (draw-segment graph x1 y1 x2 y2 color))) 
 
(defun compute-limits-from-data (graph) 
  (with-slots (auto-limits-x auto-limits-y data-view data x-min x-max y-min y-max 
                             x-tick-marks y-tick-marks) graph 
    (when auto-limits-x 
      (setq x-min (or (min-tick-mark x-tick-marks) (first-x data))) 
      (setq x-max (or (max-tick-mark x-tick-marks) (first-x data)))) 
    (when auto-limits-y 
      (setq y-min (or (min-tick-mark y-tick-marks) (first-y data))) 
      (setq y-max (or (max-tick-mark y-tick-marks) (first-y data)))) 
    (when (or auto-limits-x auto-limits-y) 
      (loop for list in data do 
            (setq list (rest list)) 
            (cond ((atom (first list)) 
                   (when auto-limits-y 
                     (loop for y in list do 
                           (if (< y y-min) (setq y-min y)) 
                           (if (> y y-max) (setq y-max y)))) 
                   (when auto-limits-x 
                     (if (< 1 x-min) (setq x-min 1)) 
                     (if (> (length list) x-max) (setq x-max (length list))))) 
                  (t (loop for (x y) in list do  
                           (when auto-limits-y 
                             (if (< y y-min) (setq y-min y)) 
                             (if (> y y-max) (setq y-max y))) 
                           (when auto-limits-x 
                             (if (< x x-min) (setq x-min x)) 
                             (if (> x x-max) (setq x-max x))))))) 
      (when (= y-min y-max) 
        (format t "~%Warning: all lines are flat at ~A" y-min) 
        (if (> y-max 0) 
          (setq y-min 0) 
          (setq y-min (- y-max 1)))) 
      (g-set-coordinate-system data-view x-min y-min x-max y-max :lower-left)))) 
 
(defun grid-graph (&optional grid-densit graph)               ;<a name="grid-graph"</a>[<a href="graph.html#grid-graph">Doc</a>] 
  (setq graph (choose-graph graph)) 
  (with-slots (data-view grid-density x-tick-marks y-tick-marks  
                         x-max x-min y-max y-min main-color) graph 
    (when grid-densit (setq grid-density grid-densit)) 
    (setq grid-density (or grid-density 5)) 
    (loop for x-and-label in x-tick-marks 
      for x = (first x-and-label)
      for dx = (gd-coord-x data-view x) 
      when (<= x-min x x-max) 
      do (loop for dy from (gd-coord-y data-view y-min) downto (gd-coord-y data-view y-max) by grid-density
           do (gd-draw-point data-view dx dy main-color)))
    (loop for y-and-label in y-tick-marks 
      for y = (first y-and-label)
      for dy = (gd-coord-y data-view y) 
      when (<= y-min y y-max) 
      do (loop for dx from (gd-coord-x data-view x-min) to (gd-coord-x data-view x-max) by grid-density 
           do (gd-draw-point data-view dx dy main-color)))))
 
#|
(defmethod g-cursor ((v data-view) x y) 
  (declare (ignore x y)) 
  *cross-hair-cursor*) 
|#

(defmethod g-click-event-handler ((v data-view) x y) 
    (print (list  x y))) 
 
(defmethod view-key-event-handler ((graph graph) char) 
  (with-slots (data highlight-p highlight-line) graph 
    (case char 
      ((#\h #\Space) 
       (setq highlight-p (not highlight-p)) 
       (draw-highlight graph)) 
      (#\                              ; back arrow 
       (when highlight-p 
         (draw-highlight graph) 
         (setf highlight-line (mod (- highlight-line 1) (length data))) 
         (draw-highlight graph))) 
      (#\                              ; space or forward arrow 
       (when highlight-p 
         (draw-highlight graph) 
         (setf highlight-line (mod (+ highlight-line 1) (length data))) 
         (draw-highlight graph)))))) 
 
(defun draw-highlight (graph) 
  (with-slots (data highlight-line highlight-color) graph 
    (draw-line graph (rest (nth highlight-line data)) highlight-color))) 
 
(defun draw-line (graph line color) 
  (if (atom (first line)) 
    (draw graph line color) 
    (draw-xy graph line color))) 

 
(export '(histogram histogram+)) 
 
; A histogram is a graph, created in a particular way 
 
; (histogram data num-bins min max graph) 
 
(defun histogram (data &key num-bins min max-excl color graph)                                   ;<a name="histogram"</a>[<a href="graph.html#histogram">Doc</a>] 
  "plots histogram of data, min <= data < max-excl, in a color on a graph named graph" 
  (unless data (error "No graphing data")) 
  (when (= (length data) 1) (error "Can't histogram a single datum")) 
  (unless min (setq min (loop for d in data minimize d))) 
  (let ((max (loop for d in data maximize d))) 
    (when (= max min) (error "Data min=max; no histogram possible")) 
    (when (and (integerp max) (integerp min)) 
             (unless max-excl (setq max-excl (+ 1 max))) 
             (unless (or num-bins (> (- max min) 200)) 
               (setq num-bins (- max-excl min)))) 
    (unless num-bins (setq num-bins 30)) 
    (unless max-excl (setq max-excl (+ max (* .00001 (/ (- max min) num-bins)))))) 
  (setq graph (choose-graph graph)) 
  (when (string= "Graph" (window-title graph)) (set-window-title graph "Histogram")) 
  (setf (slot-value graph 'boxy) t) 
  (loop with bins = (make-array num-bins :initial-element 0) 
        with num-too-small = 0 and num-too-big = 0 
        with scale-factor = (/ num-bins (- max-excl min)) 
        for d in data 
        for bin = (truncate (* (- d min) scale-factor)) 
        do (cond ((< bin 0) (incf num-too-small)) 
                 ((>= bin num-bins) (incf num-too-big)) 
                 (t (incf (aref bins bin)))) 
        finally (progn (graph (loop for i below num-bins 
                                    collect (list (+ min (/ i scale-factor)) 
                                                  (aref bins i)) 
                                    when (= i (- num-bins 1))  
                                    collect (list max-excl (aref bins i))) 
                              color graph) 
                       (unless (= 0 num-too-big)  
                         (format t "~%~A data points were above the range" num-too-big)) 
                       (unless (= 0 num-too-small)  
                         (format t "~%~A data points were below the range" num-too-small))))) 
 
(defun histogram+ (data &key num-bins min max-excl color graph)                              ;<a name="histogram+"</a>[<a href="graph.html#histogram+">Doc</a>] 
  "adds histogram of data, min <= data < max-excl, in a color to a graph named graph" 
  (unless data (error "No graphing data")) 
  (when (= (length data) 1) (error "Can't histogram a single datum")) 
  (unless min (setq min (loop for d in data minimize d))) 
  (let ((max (loop for d in data maximize d))) 
    (when (= max min) (error "Data min=max; no histogram possible")) 
    (when (and (integerp max) (integerp min)) 
             (unless max-excl (setq max-excl (+ 1 max))) 
             (unless (or num-bins (> (- max min) 200)) 
               (setq num-bins (- max-excl min)))) 
    (unless num-bins (setq num-bins 30)) 
    (unless max-excl (setq max-excl (+ max (* .00001 (/ (- max min) num-bins)))))) 
  (setq graph (choose-graph graph)) 
  (when (string= "Graph" (window-title graph)) (set-window-title graph "Histogram")) 
  (setf (slot-value graph 'boxy) t) 
  (loop with bins = (make-array num-bins :initial-element 0) 
        with num-too-small = 0 and num-too-big = 0 
        with scale-factor = (/ num-bins (- max-excl min)) 
        for d in data 
        for bin = (truncate (* (- d min) scale-factor)) 
        do (cond ((< bin 0) (incf num-too-small)) 
                 ((>= bin num-bins) (incf num-too-big)) 
                 (t (incf (aref bins bin)))) 
        finally (progn (graph+ (loop for i below num-bins 
                                     collect (list (+ min (/ i scale-factor)) 
                                                   (aref bins i)) 
                                     when (= i (- num-bins 1))  
                                     collect (list max-excl (aref bins i))) 
                               color graph) 
                       (unless (= 0 num-too-big)  
                         (format t "~%~A data points were above the range" num-too-big)) 
                       (unless (= 0 num-too-small)  
                         (format t "~%~A data points were below the range" num-too-small)))))

#| EXAMPLES:

(graph '(1 2 3 3 2 1))                                  ;Graphs the numbers, as heights

(graph (loop for x from 0 to 20 by .1 collect (sin x)))  ;Graphs (sin x)

(graph '((1 5) (7 8) (4 2)))     ;Graphs line by x,y coordinates

(graph (loop for x from 0 to 3.14 by .01                 ;Detailed graph of (sin x)
             collect (list x (sin x)))) 

(graph (list (loop for x from 0 to 20 collect (sin x))   ;Graphs (sin x) and (cos x)
             (loop for x from 0 to 20 collect (cos x)))) ;as 2 lines on the same graph 

(graph (loop for x below 20 collect (sin x)) "Sine")      ; new graph window

(graph (loop for x below 20 collect (cos x)) "Cosine")    ; 2nd graph window

(graph (loop for x from 0 to 3.14 by .01
             collect (sin x)) "Sine")

;; ADDING TO EXISTING GRAPH

(graph (loop for x below 20 collect (sin x)) :red)        ; red sin line

(graph+ (loop for x below 20 collect (cos x)) :blue)     ; second blue line on same graph

;; HISTOGRAM

(histogram (loop repeat 100 collect (random 10)))

|#
'done