# HG changeset patch # User Steve Losh # Date 1621802583 14400 # Node ID 25d07c1574959fb3e024b9070f6c6f935150b67c # Parent 6bf064d46006ab40170d0ad234770d2e2e5d14b3 Redo gnuplot interface, add CONCATENATING iterate driver diff -r 6bf064d46006 -r 25d07c157495 .hgignore --- a/.hgignore Sat Apr 10 13:26:30 2021 -0400 +++ b/.hgignore Sun May 23 16:43:03 2021 -0400 @@ -1,2 +1,3 @@ scratch.lisp plot.png +plot.pdf diff -r 6bf064d46006 -r 25d07c157495 DOCUMENTATION.markdown --- a/DOCUMENTATION.markdown Sat Apr 10 13:26:30 2021 -0400 +++ b/DOCUMENTATION.markdown Sun May 23 16:43:03 2021 -0400 @@ -1108,62 +1108,57 @@ ### `GNUPLOT` (function) - (GNUPLOT DATA &REST ARGS &KEY (X #'CAR) (Y #'CDR) (SPEW-OUTPUT NIL) &ALLOW-OTHER-KEYS) - -Plot `data` to `filename` with gnuplot. - - This will (silently) quickload the `external-program` system to handle the - communication with gnuplot. - - `data` should be a sequence of data points to plot. - - `x` should be a function to pull the x-values from each item in data. - - `y` should be a function to pull the y-values from each item in data. - - See the docstring of `gnuplot-args` for other keyword arguments. + (GNUPLOT DATA COMMANDS) + +Graph `data` with gnuplot using `commands`. + + `data` must be an alist of `(identifier . data)` pairs. `identifier` must be + a string of the form `$foo`. `data` must be a sequence of sequences of data + or a 2D array of data. + + `commands` must be a string or a sequence of strings. + + + +### `GNUPLOT-COMMAND` (function) + + (GNUPLOT-COMMAND COMMAND &AUX (S (PROCESS-INPUT-STREAM *GNUPLOT-PROCESS*))) + +Send the string `command` to the currently-running gnuplot process. + + Must be called from inside `with-gnuplot`. -### `GNUPLOT-ARGS` (function) - - (GNUPLOT-ARGS &KEY (OUTPUT :QT) (FILENAME plot.png) (STYLE :LINES) (SIZE-X 1200) (SIZE-Y 800) - (LABEL-X) (LABEL-Y) (LINE-TITLE 'DATA) (LINE-WIDTH 4) (SMOOTH NIL) (AXIS-X NIL) - (AXIS-Y NIL) (MIN-X NIL) (MAX-X NIL) (MIN-Y NIL) (MAX-Y NIL) (TICS-X NIL) - (TICS-Y NIL) (GRAPH-TITLE) (LOGSCALE-X NIL) (LOGSCALE-Y NIL) (BOX-WIDTH NIL) - &ALLOW-OTHER-KEYS) - -Return the formatted command line arguments for the given gnuplot arguments. - - You shouldn't call this function directly — it's exposed just so you can see - the list of possible gnuplot arguments all in one place. +### `GNUPLOT-DATA` (function) + + (GNUPLOT-DATA IDENTIFIER DATA &AUX (S (PROCESS-INPUT-STREAM *GNUPLOT-PROCESS*))) + +Bind `identifier` to `data` inside the currently-running gnuplot process. + + `identifier` must be a string of the form `$foo`. + + `data` must be a sequence of sequences of data or a 2D array of data. + + Must be called from inside `with-gnuplot`. -### `GNUPLOT-FUNCTION` (function) - - (GNUPLOT-FUNCTION FUNCTION &REST ARGS &KEY (START 0.0) (END 1.0) (STEP 0.1) (INCLUDE-END NIL) - &ALLOW-OTHER-KEYS) - -Plot `function` over `[start, end)` by `step` with gnuplot. - - If `include-end` is `t` the `end` value will also be plotted. - - See the docstring of `gnuplot-args` for other keyword arguments. +### `GNUPLOT-FORMAT` (function) + + (GNUPLOT-FORMAT FORMAT-STRING &REST ARGS &AUX (S (PROCESS-INPUT-STREAM *GNUPLOT-PROCESS*))) + +Send a `cl:format`ed string to the currently-running gnuplot process. + + Must be called from inside `with-gnuplot`. -### `GNUPLOT-HISTOGRAM` (function) - - (GNUPLOT-HISTOGRAM DATA &REST ARGS &KEY (BIN-WIDTH 1) &ALLOW-OTHER-KEYS) - -Plot `data` as a histogram with gnuplot. - - `bin-width` should be the desired width of the bins. The bins will be - centered on multiples of this number, and data will be rounded to the nearest - bin. - - +### `WITH-GNUPLOT` (macro) + + (WITH-GNUPLOT + &BODY + BODY) ## Package `LOSH.HASH-SETS` @@ -1978,6 +1973,111 @@ Simple ring buffer implementation. +### `DO-RING-BUFFER` (macro) + + (DO-RING-BUFFER (SYMBOL RING-BUFFER) + &BODY + BODY) + +Iterate over `ring-buffer`, executing `body` with `symbol` bound to each element. + + Elements are walked oldest to newest. + + + +### `MAKE-RING-BUFFER` (function) + + (MAKE-RING-BUFFER &KEY (SIZE 64)) + +Create and return a fresh ring buffer able to hold `(1- size)` elements. + +### `RB-CLEAR` (function) + + (RB-CLEAR RING-BUFFER) + +Clear the contents of `ring-buffer`. + +### `RB-CONTENTS` (function) + + (RB-CONTENTS RING-BUFFER &KEY (RESULT-TYPE 'LIST)) + +Return a fresh sequence of the contents of `ring-buffer` (oldest to newest). + + `result-type` can be `list` or `vector`. + + + +### `RB-COUNT` (function) + + (RB-COUNT RING-BUFFER) + +Return the number of elements currently stored in `ring-buffer`. + +### `RB-EMPTY-P` (function) + + (RB-EMPTY-P RING-BUFFER) + +Return whether `ring-buffer` is empty. + +### `RB-FULL-P` (function) + + (RB-FULL-P RING-BUFFER) + +Return whether `ring-buffer` is full. + +### `RB-POP` (function) + + (RB-POP RING-BUFFER) + +Remove and return the oldest element of `ring-buffer`, or signal an error if it is empty. + +### `RB-PUSH` (function) + + (RB-PUSH RING-BUFFER OBJECT) + +Push `object` into `ring-buffer` and return `object`. + + If `ring-buffer` is full, its oldest element will be silently dropped. If you + want an error to be signaled instead, use `rb-safe-push`. + + + +### `RB-REF` (function) + + (RB-REF RING-BUFFER INDEX) + +Return the element of `ring-buffer` at `index`. + + Elements are indexed oldest to newest: element 0 is the oldest element in the + ring buffer, element 1 is the second oldest, and so on. + + Negative indices are supported: element -1 is the newest element, element -2 + the second newest, and so on. + + An error will be signaled if `index` is out of range. + + + +### `RB-SAFE-PUSH` (function) + + (RB-SAFE-PUSH RING-BUFFER OBJECT) + +Push `object` into `ring-buffer`, or signal an error if it is already full. + +### `RB-SIZE` (function) + + (RB-SIZE RING-BUFFER) + +Return the size of `ring-buffer`. + + A ring buffer can hold at most `(1- (rb-size ring-buffer))` elements. + + + +### `RING-BUFFER` (struct) + +Slots: `DATA`, `R`, `W` + ## Package `LOSH.SEQUENCES` Utilities for operating on sequences. diff -r 6bf064d46006 -r 25d07c157495 src/gnuplot.lisp --- a/src/gnuplot.lisp Sat Apr 10 13:26:30 2021 -0400 +++ b/src/gnuplot.lisp Sun May 23 16:43:03 2021 -0400 @@ -1,165 +1,88 @@ (in-package :losh.gnuplot) -(defun gnuplot-args% (&rest args) - (mapcan (lambda (arg) (list "-e" arg)) - (remove nil args))) - -(defun gnuplot-args (&key - (output :qt) - (filename "plot.png") - (style :lines) - (size-x 1200) - (size-y 800) - (label-x) - (label-y) - (line-title 'data) - (line-width 4) - (smooth nil) - (axis-x nil) - (axis-y nil) - (min-x nil) - (max-x nil) - (min-y nil) - (max-y nil) - (tics-x nil) - (tics-y nil) - (graph-title) - (logscale-x nil) - (logscale-y nil) - (box-width nil) - &allow-other-keys) - "Return the formatted command line arguments for the given gnuplot arguments. - - You shouldn't call this function directly — it's exposed just so you can see - the list of possible gnuplot arguments all in one place. +;;; This very spartan gnuplot interface is inspired by the advice in Gnuplot in +;;; Action (second edition) specifically the section "Thought for the design of +;;; a gnuplot access layer" on page 253. - " - (check-type axis-x boolean) - (check-type axis-y boolean) - (check-type logscale-x boolean) - (check-type logscale-y boolean) - (check-type line-width (or integer float)) - (check-type box-width (or null integer float)) - (check-type min-x (or null integer float)) - (check-type min-y (or null integer float)) - (check-type max-x (or null integer float)) - (check-type max-y (or null integer float)) - (check-type tics-x (or null integer float)) - (check-type tics-y (or null integer float)) - (check-type graph-title (or null string)) - (check-type label-x (or null string)) - (check-type label-y (or null string)) - (check-type smooth (member nil :unique :frequency :csplines :acsplines :bezier :sbezier)) - (flet ((esc (string) (remove #\' (aesthetic-string string))) - (f (&rest args) (apply #'format nil (substitute "" nil args)))) - (gnuplot-args% - (ccase output - ((:x :x11) (f "set terminal x11 persist")) - (:qt (f "set terminal qt")) - (:wxt (f "set terminal wxt persist")) - (:png - (f "set terminal pngcairo dashed size ~D,~D font \"Lucida Grande,20\"" - size-x size-y) - (f "set output '~A'" (esc filename)))) - (f "set border linewidth 1") - (f "set style line 10 dashtype 2 linewidth 3 linecolor \"#666666\"") - (when axis-x (f "set xzeroaxis linestyle 10")) - (when axis-y (f "set yzeroaxis linestyle 10")) - (when tics-x (f "set xtics ~A" tics-x)) - (when tics-y (f "set ytics ~A" tics-y)) - (when box-width (f "set boxwidth ~A" box-width)) - (when graph-title (f "set title '~A'" (esc graph-title))) - (when label-x (f "set xlabel '~A'" (esc label-x))) - (when label-y (f "set ylabel '~A'" (esc label-y))) - (when logscale-x (f "set logscale x")) - (when logscale-y (f "set logscale y")) - (f "set xrange [~A:~A]" min-x max-x) - (f "set yrange [~A:~A]" min-y max-y) - (f "plot '-' using 1:2 title '~A' with ~(~A~) linewidth ~D ~A" - (esc line-title) style line-width - (when smooth (f "smooth ~(~A~)" smooth))) - (f "pause mouse close")))) +(defparameter *gnuplot-path* "gnuplot") +(defparameter *gnuplot-process* nil) + +(defmacro with-gnuplot (&body body) + `(let ((*gnuplot-process* + (external-program:start *gnuplot-path* '() :input :stream :output t))) + (unwind-protect (progn ,@body *gnuplot-process*) + (close (external-program:process-input-stream *gnuplot-process*))))) -(defun gnuplot (data &rest args &key - (x #'car) - (y #'cdr) - (spew-output nil) - &allow-other-keys) - "Plot `data` to `filename` with gnuplot. +(defun gnuplot-data-sequence% (sequence s) + (map nil (lambda (row) + (map nil (lambda (val) + (princ val s) + (princ #\tab s)) + row) + (terpri s)) + sequence)) - This will (silently) quickload the `external-program` system to handle the - communication with gnuplot. - - `data` should be a sequence of data points to plot. +(defun gnuplot-data-matrix% (matrix s) + (destructuring-bind (rows cols) (array-dimensions matrix) + (dotimes (r rows) + (dotimes (c cols) + (princ (aref matrix r c) s) + (princ #\tab s)) + (terpri s)))) - `x` should be a function to pull the x-values from each item in data. +(defun gnuplot-data (identifier data &aux (s (external-program:process-input-stream *gnuplot-process*))) + "Bind `identifier` to `data` inside the currently-running gnuplot process. - `y` should be a function to pull the y-values from each item in data. + `identifier` must be a string of the form `$foo`. - See the docstring of `gnuplot-args` for other keyword arguments. + `data` must be a sequence of sequences of data or a 2D array of data. + + Must be called from inside `with-gnuplot`. " - (funcall (read-from-string "ql:quickload") 'external-program :silent t) - (let* ((process (funcall (read-from-string "external-program:start") - "gnuplot" - (apply #'gnuplot-args args) - :input :stream - :output (if spew-output *standard-output* nil))) - (in (funcall (read-from-string "external-program:process-input-stream") - process))) - (unwind-protect - (progn - (iterate (for item :in-whatever data) - (format in "~F ~F~%" (funcall x item) (funcall y item))) - (finish-output in)) - (close in)) - process)) + (assert (not (null *gnuplot-process*)) () "~A must be called inside ~S" 'gnuplot-data 'with-gnuplot) + (check-type identifier string) + (assert (char= #\$ (char identifier 0))) + (format s "~A << EOD~%" identifier) + (etypecase data + ((array * (* *)) (gnuplot-data-matrix% data s)) + (sequence (gnuplot-data-sequence% data s))) + (format s "EOD~%")) -(defun gnuplot-function (function &rest args &key - (start 0.0) - (end 1.0) - (step 0.1) - (include-end nil) - &allow-other-keys) - "Plot `function` over `[start, end)` by `step` with gnuplot. +(defun gnuplot-format (format-string &rest args &aux (s (external-program:process-input-stream *gnuplot-process*))) + "Send a `cl:format`ed string to the currently-running gnuplot process. - If `include-end` is `t` the `end` value will also be plotted. - - See the docstring of `gnuplot-args` for other keyword arguments. + Must be called from inside `with-gnuplot`. " - (let* ((x (range start end :step step)) - (x (append x - (when (and include-end - (/= (car (last x)) end)) - (list end)))) - (y (mapcar function x)) - (data (mapcar #'cons x y))) - (apply #'gnuplot data args))) + (assert (not (null *gnuplot-process*)) () "~A must be called inside ~S" 'gnuplot-format 'with-gnuplot) + (apply #'format s format-string args) + (terpri s)) +(defun gnuplot-command (command &aux (s (external-program:process-input-stream *gnuplot-process*))) + "Send the string `command` to the currently-running gnuplot process. -(defun gnuplot-histogram (data &rest args &key - (bin-width 1) - &allow-other-keys) - "Plot `data` as a histogram with gnuplot. - - `bin-width` should be the desired width of the bins. The bins will be - centered on multiples of this number, and data will be rounded to the nearest - bin. + Must be called from inside `with-gnuplot`. " - (-<> data - (mapcar (lambda (y) - (* bin-width (round y bin-width))) - <>) - frequencies - alexandria:hash-table-alist - (apply #'gnuplot <> - :style :boxes - :min-y 0 - :line-width 1 - :box-width (* bin-width 1.0) - args))) + (assert (not (null *gnuplot-process*)) () "~A must be called inside ~S" 'gnuplot-command 'with-gnuplot) + (write-line command s)) + +(defun gnuplot (data commands) + "Graph `data` with gnuplot using `commands`. + + `data` must be an alist of `(identifier . data)` pairs. `identifier` must be + a string of the form `$foo`. `data` must be a sequence of sequences of data + or a 2D array of data. + `commands` must be a string or a sequence of strings. + " + (with-gnuplot + (dolist (d data) + (gnuplot-data (car d) (cdr d))) + (etypecase commands + (string (gnuplot-command commands)) + (sequence (map nil #'gnuplot-command commands))))) + diff -r 6bf064d46006 -r 25d07c157495 src/hash-sets.lisp --- a/src/hash-sets.lisp Sat Apr 10 13:26:30 2021 -0400 +++ b/src/hash-sets.lisp Sun May 23 16:43:03 2021 -0400 @@ -31,7 +31,7 @@ themselves will not be copied. " - (make-hash-set% :storage (copy-hash-table (hash-set-storage hset)))) + (make-hash-set% :storage (alexandria:copy-hash-table (hash-set-storage hset)))) (defmacro define-hset-op (name arglist &body body) diff -r 6bf064d46006 -r 25d07c157495 src/iterate.lisp --- a/src/iterate.lisp Sat Apr 10 13:26:30 2021 -0400 +++ b/src/iterate.lisp Sun May 23 16:43:03 2021 -0400 @@ -665,6 +665,68 @@ (with ,hash-table = (make-hash-table :test ,test)) (incf (gethash ,expr ,hash-table 0))))) +(defmacro-clause (CONCATENATING expr &optional INTO var SEPARATOR separator) + "Concatenate the string `expr` into `var`. + + If `var` is not given, `expr` will be accumulated into a string output stream + and the result returned. + + If `var` is given, `expr` will be concatenated onto it. Whether `var` is + a fresh string each time or whether an adjustable string is mutated is + implementation defined. + + If `separator` is not `nil`, it must be a string designator. + + Examples: + + (iterate (for s :in '(\"foo\" \"bar\" \"baz\")) + (concatenating s)) + ; => \"foobarbaz\" + + (iterate (for s :in '(\"foo\" \"bar\" \"baz\")) + (concatenating s :separator #\,)) + ; => \"foo,bar,baz\" + + (iterate (for s :in '(\"foo\" \"bar\" \"baz\")) + (concatenating s :separator \", \")) + ; => \"foo, bar, baz\" + + (iterate (for s :in '(\"foo\" \"bar\" \"baz\")) + (concatenating s :separator #\, :into v) + (format t \"> ~A~%\" v) + (collect v)) + ; => > foo + ; => > foo,bar + ; => > foo,bar,baz + ; + ; Implementation defined result, might be one of: + ; => (\"foo\" \"foo,bar\" \"foo,bar,baz\") ; 3 fresh strings + ; => (\"foo,bar,baz\" \"foo,bar,baz\" \"foo,bar,baz\") ; same string + + " + (if var + (let ((sep (gensym "SEP"))) + `(progn + (with ,sep = ,(if separator (string separator) "")) + (reducing ,expr + :by (lambda (a b) + (if (null a) + (copy-seq b) + (concatenate 'string a ,sep b))) + :into ,var + :initial-value nil))) + (let ((sos (gensym "SOS")) + (sep (gensym "SEP"))) + `(progn + (with ,sos = (make-string-output-stream)) + (with ,sep = ,(if separator (string separator) nil)) + (if-first-time + nil + (when ,sep (write-string ,sep ,sos))) + (write-string ,expr ,sos) + (finally (return (get-output-stream-string ,sos))))))) + + (defmacro-clause (ORING expr &optional INTO var) (let ((result (or var iterate::*result-var*))) @@ -731,7 +793,11 @@ (defmacro-driver (FOR var IN-RING-BUFFER ring-buffer) - "Iterate over the elements of `ring-buffer`, oldest to newest." + "Iterate over the elements of `ring-buffer`, oldest to newest. + + Does not modify the ring buffer. + + " (let ((kwd (if generate 'generate 'for))) (with-gensyms (rb r w d s) `(progn diff -r 6bf064d46006 -r 25d07c157495 src/package.lisp --- a/src/package.lisp Sat Apr 10 13:26:30 2021 -0400 +++ b/src/package.lisp Sun May 23 16:43:03 2021 -0400 @@ -308,6 +308,7 @@ :collect-hash :collect-set :cycling + :concatenating :end :every-nth :finding-all @@ -424,9 +425,10 @@ (:documentation "Utilities for plotting data with gnuplot.") (:export :gnuplot - :gnuplot-args - :gnuplot-function - :gnuplot-histogram)) + :with-gnuplot + :gnuplot-data + :gnuplot-command + :gnuplot-format)) (defpackage :losh.weightlists (:use :cl :iterate :losh.base