diff options
Diffstat (limited to 'charplot.scm')
| -rw-r--r-- | charplot.scm | 65 |
1 files changed, 38 insertions, 27 deletions
diff --git a/charplot.scm b/charplot.scm index 2c64615..3e0e019 100644 --- a/charplot.scm +++ b/charplot.scm @@ -1,9 +1,9 @@ ;;;; "charplot.scm", plotting on character devices for Scheme -;;; Copyright (C) 1992, 1993 Aubrey Jaffer. +;;; Copyright (C) 1992, 1993 Aubrey Jaffer ; -;Permission to copy this software, to redistribute it, and to use it -;for any purpose is granted, subject to the following restrictions and -;understandings. +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. ; ;1. Any copy made of this software must include this copyright notice ;in full. @@ -19,6 +19,8 @@ (require 'sort) (require 'printf) +(require 'array) +(require 'array-for-each) (define charplot:rows 24) (define charplot:columns (output-port-width (current-output-port))) @@ -47,31 +49,33 @@ (define (charplot:number->string x) (sprintf #f "%g" x)) -(define (scale-it z scale) +(define (charplot:scale-it z scale) (if (and (exact? z) (integer? z)) (quotient (* z (car scale)) (cadr scale)) (inexact->exact (round (/ (* z (car scale)) (cadr scale)))))) -(define (find-scale isize delta) - (if (inexact? delta) (set! isize (exact->inexact isize))) +(define (charplot:find-scale isize delta) + (define (fs2) + (cond ((< (* delta 8) isize) 8) + ((< (* delta 6) isize) 6) + ((< (* delta 5) isize) 5) + ((< (* delta 4) isize) 4) + ((< (* delta 3) isize) 3) + ((< (* delta 2) isize) 2) + (else 1))) + (cond ((zero? delta) (set! delta 1)) + ((inexact? delta) (set! isize (exact->inexact isize)))) (do ((d 1 (* d 10))) ((<= delta isize) (do ((n 1 (* n 10))) ((>= (* delta 10) isize) - (list (* n (cond ((< (* delta 8) isize) 8) - ((< (* delta 6) isize) 6) - ((< (* delta 5) isize) 5) - ((< (* delta 4) isize) 4) - ((< (* delta 3) isize) 3) - ((< (* delta 2) isize) 2) - (else 1))) - d)) + (list (* n (fs2)) d)) (set! delta (* delta 10)))) (set! isize (* isize 10)))) (define (charplot:iplot! data xlabel ylabel xmin xscale ymin yscale) - (define xaxis (- (scale-it ymin yscale))) - (define yaxis (- (scale-it xmin xscale))) + (define xaxis (- (charplot:scale-it ymin yscale))) + (define yaxis (- (charplot:scale-it xmin xscale))) (charplot:center-print! ylabel 11) (charplot:printn! (+ charplot:width 1) charplot:xborder) (newline) @@ -122,7 +126,7 @@ (display charplot:yborder) (newline) (charplot:center-print! xlabel (+ 12 fudge (- xstep/2))) (do ((i fudge (+ i xstep))) - ((> (+ i xstep) charplot:width)) + ((>= i charplot:width)) (charplot:center-print! (charplot:number->string (/ (* (- i yaxis) (cadr xscale)) (car xscale))) @@ -131,23 +135,30 @@ (define (charplot:plot! data xlabel ylabel) (cond ((array? data) - (set! data (map (lambda (lst) (cons (car lst) (cadr lst))) - (array->list data))))) + (case (array-rank data) + ((1) (set! data (map cons + (let ((ra (apply make-array #f + (array-shape data)))) + (array-index-map! ra identity) + (array->list ra)) + (array->list data)))) + ((2) (set! data (map (lambda (lst) (cons (car lst) (cadr lst))) + (array->list data))))))) (let* ((xmax (apply max (map car data))) (xmin (apply min (map car data))) - (xscale (find-scale charplot:width (- xmax xmin))) + (xscale (charplot:find-scale charplot:width (- xmax xmin))) (ymax (apply max (map cdr data))) (ymin (apply min (map cdr data))) - (yscale (find-scale charplot:height (- ymax ymin))) - (ixmin (scale-it xmin xscale)) - (iymin (scale-it ymin yscale))) + (yscale (charplot:find-scale charplot:height (- ymax ymin))) + (ixmin (charplot:scale-it xmin xscale)) + (iymin (charplot:scale-it ymin yscale))) (charplot:iplot! (map (lambda (p) - (cons (- (scale-it (car p) xscale) ixmin) - (- (scale-it (cdr p) yscale) iymin))) + (cons (- (charplot:scale-it (car p) xscale) ixmin) + (- (charplot:scale-it (cdr p) yscale) iymin))) data) xlabel ylabel xmin xscale ymin yscale))) -(define (plot-function func vlo vhi . npts) +(define (plot-function! func vlo vhi . npts) (set! npts (if (null? npts) 100 (car npts))) (let ((dats (make-array 0.0 npts 2))) (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts) |