#lang scheme/base
;;; PLT Scheme Science Collection
;;; plot-discrete.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 module adds discrete plots to the plot collection included
;;; with PLT Scheme.
;;;
;;; Version  Date      Description
;;; 1.0.0    09/30/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 
 discrete)

;;; Draw a bar if height y and the specified width centered at the
;;; given x coordinate.
(define (draw-bar x width y view)
  (let* ((width/2 (/ width 2.0))
         (x1 (- x width/2))
         (x2 (+ x width/2)))
    (send view fill
          `(,x1 ,x1 ,x2 ,x2)
          `(0 ,y ,y 0))))

;;; Draw binned discrete data.  [n1, n2] is the bin range.
(define (draw-discrete bins n1 n2 width view)
  (let ((n (vector-length bins)))
    (do ((i 0 (+ i 1)))
        ((= i n) (void))
      (let ((x (+ n1 i)))
        (draw-bar x width (vector-ref bins i) view)))))

;;; Draw a discrete function.
(define (draw-discrete-function f x-min x-max width view)
  (let ((n1 (inexact->exact (ceiling x-min)))
        (n2 (inexact->exact (floor x-max))))
    (do ((i n1 (+ i 1)))
        ((> i n2) (void))
      (draw-bar i width (f i) view))))

;;; Discrete plot extender.
(define-plot-type discrete
  data 2dview (x-min x-max) ((width .5) (color 'black))
  (begin
    (send 2dview set-line-color color)
    (cond ((and (list? data)
                (= (length data) 3)
                (integer? (car data))
                (integer? (cadr data))
                (vector? (caddr data)))
           ;; Binned discrete data: (n1 n1 bins)
           (draw-discrete (caddr data) (car data) (cadr data) width 2dview))
          ((procedure? data)
           ;; Discrete function
           (draw-discrete-function data x-min x-max width 2dview))
          (else
           (error 'discrete
                  "data format unknown")))))