summaryrefslogtreecommitdiffstats
path: root/grapheps.scm
diff options
context:
space:
mode:
Diffstat (limited to 'grapheps.scm')
-rw-r--r--grapheps.scm53
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