#lang scheme/base
;;; PLT Scheme Science Collection
;;; plot-histogram.ss
;;; Copyright (c) 2004-2008 M. Douglas Williams
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;;; 02111-1307 USA.
;;;
;;; -------------------------------------------------------------------
;;;
;;; This code adds histogram plotting to the PLoT collection in PLT
;;; Scheme (lib "plot.ss" "plot").
;;;
;;; Version Date      Description
;;; 0.1.0   08/27/04  This is the initial release of the histogram
;;;                   plotting extension to the PLoT collection in PLT
;;;                   Scheme (Doug Williams)
;;; 1.0.0   09/28/04  Marked as ready for Release 1.0.  (Doug Williams)
;;; 2.0.0   06/07/08  More V4.0 changes.  (Doug Williams)

(require (lib "class.ss")
         (lib "plot-extend.ss" "plot"))

(provide
 histogram)

;;; Draw a bar given the width
(define (draw-bar-given-width x width width-factor y view)
  (let* ((half-whitespace (/ (* width (- 1.0 width-factor)) 2.0))
         (x1 (+ x half-whitespace))
         (x2 (- (+ x width) half-whitespace)))
    (send view fill
          `(,x1 ,x1 ,x2 ,x2)
          `(0 ,y ,y 0))))

;;; Draw a bar
(define (draw-bar x1 x2 width-factor y view)
  (let* ((half-whitespace (/ (* (- x2 x1) (- 1.0 width-factor)) 2.0))
         (xx1 (+ x1 half-whitespace))
         (xx2 (- x2 half-whitespace)))
    (send view fill
          `(,xx1 ,xx1 ,xx2 ,xx2)
          `(0 ,y ,y 0))))

;;; Draw a histogram with equal width bins
(define (draw-histogram-with-equal-width-bins 
         bins x-min x-max width-factor view)
  (let* ((n (vector-length bins))
         (bin-width (/ (- x-max x-min) n)))
    (do ((i 0 (+ i 1)))
        ((= i n) (void))
      (draw-bar-given-width
       (+ x-min (* i bin-width)) bin-width width-factor
       (vector-ref bins i) view))))

;;; Draw a histogram (with specified bin ranges)
(define (draw-histogram bins x-ranges width-factor view)
  (let ((n (vector-length bins)))
    (do ((i 0 (+ i 1)))
        ((= i n) (void))
      (draw-bar (vector-ref x-ranges i)
                (vector-ref x-ranges (+ i 1))
                width-factor
                (vector-ref bins i)
                view))))

;;; Define histogram plot type
;;;
;;; The histogram data to be plotted may be provided in either of two
;;; formats:
;;; 1) A vector of binned data - if a single vector of binned data is
;;;    given, it is interpreted as n fixed width bins, where n is the
;;;    the length of the vector, with x ranging from x-min to x-max.
;;; 2) A list of two vectors - the first contains the binned data and
;;;    the second contains the x ranges; it is interpreted as n
;;;    (possibly) variable width bins, where n is the length of the
;;;    first vector; the x range for the i-th bin are the i-th
;;;    (lower) and (i+1)-th elements of the second vector; the length
;;;    of the second vector must be one greater than the length of
;;;    the first vector.
(define-plot-type histogram
  data 2dview (x-min x-max) ((color 'black) (width 1.0))
  (begin
    (send 2dview set-line-color color)
    (set! width (max width 0.0))
    (set! width (min width 1.0))
    (cond ((vector? data)
           ;; bin data with equal width bins
           (draw-histogram-with-equal-width-bins
            data x-min x-max width 2dview))
          ((and (list? data)
                (= (length data) 2)
                (vector? (car data))
                (vector? (cadr data))
                (= (vector-length (cadr data))
                   (+ (vector-length (car data)) 1)))
           ;; bin data and limits data
           (draw-histogram (car data) (cadr data) width 2dview))
          (else
           (error 'plot
                  "histogram plot data error")))))