diff options
Diffstat (limited to 'grapheps.scm')
| -rw-r--r-- | grapheps.scm | 53 |
1 files changed, 40 insertions, 13 deletions
diff --git a/grapheps.scm b/grapheps.scm index 677ae34..d64262f 100644 --- a/grapheps.scm +++ b/grapheps.scm @@ -477,22 +477,42 @@ idx 1)))) (create-postscript-graph tmp (or graph:dimensions '(600 300)) - (whole-page) (setup-plot (column-range data 0) (column-range data 1)) + (whole-page) + (setup-plot (column-range data 0) + (apply combine-ranges + (do ((idx (+ -1 (cadr (array-dimensions data))) (+ -1 idx)) + (lst '() (cons (column-range data idx) lst))) + ((< idx 1) lst)))) (outline-rect plotrect) (x-axis) (y-axis) - (plot-column data 0 1 (if histogram? 'bargraph 'line)) + (do ((idx (+ -1 (cadr (array-dimensions data))) (+ -1 idx)) + (lst '() (cons + (plot-column data 0 idx (if histogram? 'bargraph 'line)) + lst))) + ((< idx 1) lst)) (rule-vertical leftedge ylabel 10) (rule-horizontal bottomedge xlabel 10))) -(define (graph:plot-function tmp func vlo vhi . npts) - (set! npts (if (null? npts) 200 (car npts))) - (let ((dats (make-array (A:floR64b) npts 2))) - (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts) +(define (functions->array vlo vhi npts . funcs) + (let ((dats (make-array (A:floR32b) npts (+ 1 (length funcs))))) + (define jdx 1) + (array-index-map! (make-shared-array dats + (lambda (idx) (list idx 0)) + npts) (lambda (idx) (+ vlo (* (- vhi vlo) (/ idx (+ -1 npts)))))) - (array-map! (make-shared-array dats (lambda (idx) (list idx 1)) npts) - func - (make-shared-array dats (lambda (idx) (list idx 0)) npts)) + (for-each (lambda (func) + (array-map! + (make-shared-array dats (lambda (idx) (list idx jdx)) npts) + func + (make-shared-array dats (lambda (idx) (list idx 0)) npts)) + (set! jdx (+ 1 jdx))) + funcs) + dats)) + +(define (graph:plot-function tmp func vlo vhi . npts) + (set! npts (if (null? npts) 200 (car npts))) + (let ((dats (functions->array vlo vhi npts func))) (graph:plot tmp dats "" ""))) ;;@body @@ -507,6 +527,11 @@ ;;over the range @2 to @3. If the optional integer argument @4 is ;;supplied, it specifies the number of points to evaluate @1 at. ;; +;;@defunx x1 x2 npts func1 func2 ... +;;Creates and displays an encapsulated PostScript graph of the +;;one-argument functions @var{func1}, @var{func2}, ... over the range +;;@var{x1} to @var{x2} at @var{npts} points. +;; ;;@defunx plot coords x-label y-label ;;@var{coords} is a list or vector of coordinates, lists of x and y ;;coordinates. @var{x-label} and @var{y-label} are strings with which @@ -514,13 +539,15 @@ (define (plot . args) (call-with-tmpnam (lambda (tmp) - (if (procedure? (car args)) - (apply graph:plot-function tmp args) - (apply graph:plot tmp args)) + (cond ((procedure? (car args)) + (apply graph:plot-function tmp args)) + ((array? (car args)) + (apply graph:plot tmp args)) + (else (let ((dats (apply functions->array args))) + (graph:plot tmp dats "" "")))) (system (string-append "gv '" tmp "'"))) ".eps")) - ;;@node Example Graph, , Legacy Plotting, PostScript Graphing ;;@subsubsection Example Graph |