;;; PLT Scheme Science Collection ;;; plot-discrete.ss ;;; Copyright (c) 2004 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) (module plot-discrete mzscheme (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"))))) )