; plotter - plot graph based on input parameters
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
(if (null? value)
(vector-set! m i (make-vector columns))
(vector-set! m i (make-vector columns (car value))))))
(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
(define-syntax for
(syntax-rules ()
((for (var first past step) body ...)
(let ((ge? (if (< first past) >= <=)))
(do ((var first (+ var step)))
((ge? var past))
body ...)))
((for (var first past) body ...)
(let* ((f first) (p past) (s (if (< first past) 1 -1)))
(for (var f p s) body ...)))
((for (var past) body ...)
(let* ((p past)) (for (var 0 p) body ...)))))
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
(char=? (peek-char p) c))
(read-char p)))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
(cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
(else (loop (cdr ss) (cons (car ss) cs) xs)))))
(define height 24) ; number of printable rows
(define width 80) ; number of printable columns
(define ox 10) ; x-origin, leave room for y-ticks
(define oy 1) ; y-origin, leave room for x-ticks
(define label #f) ; graph label on top row
(define y-lo #f) ; lo end of y-axis
(define y-hi #f) ; hi end of y-axis
(define x-lo #f) ; lo end of x-axis
(define x-hi #f) ; hi end of x-axis
(define y-ticks (list)) ; list of y-axis tick marks
(define x-ticks (list)) ; list of x-axis tick marks
(define data (list)) ; list of x/y points to plot
(define grid (make-matrix width height #\space))
(define (graph file-name)
(set! label #f) (set! y-lo #f) (set! y-hi #f) (set! x-lo #f) (set! x-hi #f)
(set! y-ticks (list)) (set! x-ticks (list)) (set! data (list))
(set! grid (make-matrix width height #\space))
(with-input-from-file file-name (lambda ()
(let loop ((line (read-line)))
(if (eof-object? line) (plot)
(let ((fields (string-split #\space line)))
(cond ((null? fields) (verify-parameters))
((null? (cddr fields))
(set! data (cons (cons (string->number (car fields))
(string->number (cadr fields))) data)))
((string=? (car fields) "label")
(set! label (substring line
(+ (string-length "label") 1)
(string-length line))))
((and (string=? (car fields) "left")
(string=? (cadr fields) "range"))
(set! y-lo (string->number (caddr fields)))
(set! y-hi (string->number (cadddr fields))))
((and (string=? (car fields) "bottom")
(string=? (cadr fields) "range"))
(set! x-lo (string->number (caddr fields)))
(set! x-hi (string->number (cadddr fields))))
((and (string=? (car fields) "left")
(string=? (cadr fields) "ticks"))
(set! y-ticks (map string->number (cddr fields))))
((and (string=? (car fields) "bottom")
(string=? (cadr fields) "ticks"))
(set! x-ticks (map string->number (cddr fields))))
(else (error 'graph "unrecognized input")))
(loop (read-line))))))))
(define (verify-parameters)
(when (not (and label y-lo y-hi x-lo x-hi y-ticks x-ticks))
(error 'verify-parameters "missing parameters"))
(when (not (< y-lo y-hi))
(error 'verify-parameters "invalid left range"))
(when (not (< x-lo x-hi))
(error 'verify-parameters "invalid bottom range"))
(when (not (apply < y-ticks))
(error 'verify-parameters "invalid left ticks"))
(when (not (apply < x-ticks))
(error 'verify-parameters "invalid bottom ticks")
(define (plot)
(frame) (ticks) (labels) (points) (draw))
(define (frame)
(for (i ox width)
(matrix-set! grid i oy #\-)
(matrix-set! grid i (- height 2) #\-))
(for (i oy (- height 1))
(matrix-set! grid ox i #\|)
(matrix-set! grid (- width 1) i #\|)))
(define (ticks)
(do ((ts y-ticks (cdr ts))) ((null? ts))
(matrix-set! grid ox (y-scale (car ts)) #\-)
(display-at (y-scale (car ts)) (- ox 1 (string-length (number->string (car ts))))
(number->string (car ts))))
(do ((ts x-ticks (cdr ts))) ((null? ts))
(matrix-set! grid (x-scale (car ts)) oy #\|)
(display-at (- oy 1) (- (x-scale (car ts))
(quotient (string-length (number->string (car ts))) 2))
(number->string (car ts)))))
(define (labels)
(display-at (- height oy) (quotient (- width (string-length label)) 2) label))
(define (points)
(do ((ds data (cdr ds))) ((null? ds))
(matrix-set! grid (x-scale (caar ds)) (y-scale (cdar ds)) #\*)))
(define (x-scale x)
(round (+ (* (/ (- x x-lo) (- x-hi x-lo)) (- width 1 ox)) ox)))
(define (y-scale y)
(round (+ (* (/ (- y y-lo) (- y-hi y-lo)) (- height 3 oy)) oy)))
(define (display-at r c str)
(for (i 0 (string-length str))
(matrix-set! grid (+ i c) r (string-ref str i))))
(define (draw)
(for (r (- height 1) -1 -1)
(for (c 0 width)
(display (matrix-ref grid c r)))
(newline)))