25d07c157495

Redo gnuplot interface, add CONCATENATING iterate driver
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 23 May 2021 16:43:03 -0400
parents 6bf064d46006
children ec9067ea1894
branches/tags (none)
files .hgignore DOCUMENTATION.markdown src/gnuplot.lisp src/hash-sets.lisp src/iterate.lisp src/package.lisp

Changes

--- 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
--- 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.
--- 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)))))
+
--- 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)
--- 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
--- 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