--- a/src/gnuplot.lisp Fri Mar 01 14:51:11 2019 -0500
+++ b/src/gnuplot.lisp Fri Mar 08 22:09:23 2019 -0500
@@ -5,7 +5,7 @@
(remove nil args)))
(defun gnuplot-args (&key
- (output :wxt)
+ (output :qt)
(filename "plot.png")
(style :lines)
(size-x 1200)
@@ -22,6 +22,7 @@
(min-y nil)
(max-y nil)
(tics-x nil)
+ (tics-y nil)
(graph-title)
(logscale-x nil)
(logscale-y nil)
@@ -33,12 +34,28 @@
the list of possible gnuplot arguments all in one place.
"
+ (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 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\""
@@ -47,8 +64,9 @@
(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 axis-y (f "set yzeroaxis linestyle 10"))
+ (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)))
@@ -59,12 +77,11 @@
(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))))))
+ (when smooth (f "smooth ~(~A~)" smooth)))
+ (f "pause mouse close"))))
-(defun gnuplot (data
- &rest args
- &key
+(defun gnuplot (data &rest args &key
(x #'car)
(y #'cdr)
(spew-output nil)
@@ -83,16 +100,14 @@
See the docstring of `gnuplot-args` for other keyword arguments.
"
- (uiop/package:symbol-call :ql :quickload 'external-program :silent t)
- (let* ((process (uiop/package:symbol-call
- :external-program :start
- "gnuplot"
- (apply #'gnuplot-args args)
- :input :stream
- :output (if spew-output *standard-output* nil)))
- (in (uiop/package:symbol-call
- :external-program :process-input-stream
- process)))
+ (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)
@@ -101,15 +116,13 @@
(close in))
process))
-(defun gnuplot-function (function
- &rest args
- &key
+(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.
+ "Plot `function` over `[start, end)` by `step` with gnuplot.
If `include-end` is `t` the `end` value will also be plotted.
@@ -126,9 +139,8 @@
(apply #'gnuplot data args)))
-(defun gnuplot-histogram (data
- &rest args
- &key (bin-width 1)
+(defun gnuplot-histogram (data &rest args &key
+ (bin-width 1)
&allow-other-keys)
"Plot `data` as a histogram with gnuplot.
--- a/src/iterate.lisp Fri Mar 01 14:51:11 2019 -0500
+++ b/src/iterate.lisp Fri Mar 08 22:09:23 2019 -0500
@@ -249,7 +249,6 @@
(elt ,source ,i))))))))
-
(defclause-sequence ACROSS-FLAT-ARRAY INDEX-OF-FLAT-ARRAY
:access-fn 'row-major-aref
:size-fn 'array-total-size
@@ -713,3 +712,98 @@
(initially (setf ,var ,seed)))))
+(defmacro-clause (FINDING-ALL expr MINIMIZING m-expr &optional INTO var)
+ "Collect all `expr`s minimizing `m-expr` into a list at `var`.
+
+ The partial list at `var` is available for inspection at any point in the loop.
+
+ If `m-expr` is a sharp-quoted function, then it is called on `expr` instead of
+ being evaluated and compared itself.
+
+ "
+ ;; TODO: result-type
+ (alexandria:with-gensyms (min value m-value tail)
+ (let ((result (or var iterate::*result-var*)))
+ `(progn
+ (with ,result = '())
+ (with ,tail = nil)
+ (with ,min = nil)
+ ,(typecase m-expr
+ ((cons (eql function) (cons t null))
+ `(progn
+ (for ,value = ,expr)
+ (for ,m-value = (funcall ,m-expr ,value))
+ (cond
+ ((or (null ,min)
+ (< ,m-value ,min)) (setf ,result (list ,value)
+ ,tail ,result
+ ,min ,m-value))
+ ((= ,m-value ,min) (setf (cdr ,tail) (cons ,value nil)
+ ,tail (cdr ,tail))))))
+ (t `(progn
+ (for ,m-value = ,m-expr)
+ (cond
+ ((or (null ,min)
+ (< ,m-value ,min)) (setf ,result (list ,expr)
+ ,tail ,result
+ ,min ,m-value))
+ ((= ,m-value ,min) (setf (cdr ,tail) (cons ,expr nil)
+ ,tail (cdr ,tail)))))))))))
+
+(defmacro-clause (FINDING-ALL expr MAXIMIZING m-expr &optional INTO var)
+ "Collect all `expr`s maximizing `m-expr` into a list at `var`.
+
+ The partial list at `var` is available for inspection at any point in the loop.
+
+ If `m-expr` is a sharp-quoted function, then it is called on `expr` instead of
+ being evaluated and compared itself.
+
+ "
+ ;; TODO: result-type
+ (alexandria:with-gensyms (max value m-value tail)
+ (let ((result (or var iterate::*result-var*)))
+ `(progn
+ (with ,result = '())
+ (with ,tail = nil)
+ (with ,max = nil)
+ ,(typecase m-expr
+ ((cons (eql function) (cons t null))
+ `(progn
+ (for ,value = ,expr)
+ (for ,m-value = (funcall ,m-expr ,value))
+ (cond
+ ((or (null ,max)
+ (> ,m-value ,max)) (setf ,result (list ,value)
+ ,tail ,result
+ ,max ,m-value))
+ ((= ,m-value ,max) (setf (cdr ,tail) (cons ,value nil)
+ ,tail (cdr ,tail))))))
+ (t `(progn
+ (for ,m-value = ,m-expr)
+ (cond
+ ((or (null ,max)
+ (> ,m-value ,max)) (setf ,result (list ,expr)
+ ,tail ,result
+ ,max ,m-value))
+ ((= ,m-value ,max) (setf (cdr ,tail) (cons ,expr nil)
+ ,tail (cdr ,tail)))))))))))
+
+(defmacro-clause (FINDING-ALL expr SUCH-THAT test &optional INTO var RESULT-TYPE result-type)
+ "Collect all `expr`s for which `test` is true.
+
+ If `test` is a sharp-quoted function, then it is called on `expr` instead of
+ being evaluated and compared itself.
+
+ "
+ (let ((result (or var iterate::*result-var*)))
+ (typecase test
+ ((cons (eql function) (cons t null))
+ (alexandria:with-gensyms (value)
+ `(progn
+ (for ,value = ,expr)
+ (when (funcall ,test ,value)
+ (collect ,value :into ,result
+ ,@(when result-type `(:result-type ,result-type)))))))
+ (t `(when ,test
+ (collect ,expr :into ,result
+ ,@(when result-type `(:result-type ,result-type))))))))