# HG changeset patch # User Steve Losh # Date 1552100963 18000 # Node ID 71b34a9a34137f752b911fd6201e53e2d4809365 # Parent 782fc1421b1600c05c4b350e7ae7b2907298a21d# Parent 72093637ac8bdc3ef398071fea2096cf5c634736 Merge. diff -r 72093637ac8b -r 71b34a9a3413 DOCUMENTATION.markdown --- a/DOCUMENTATION.markdown Fri Mar 01 14:51:11 2019 -0500 +++ b/DOCUMENTATION.markdown Fri Mar 08 22:09:23 2019 -0500 @@ -1055,10 +1055,11 @@ ### `GNUPLOT-ARGS` (function) - (GNUPLOT-ARGS &KEY (OUTPUT :WXT) (FILENAME plot.png) (STYLE :LINES) (SIZE-X 1200) (SIZE-Y 800) + (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) - (GRAPH-TITLE) (LOGSCALE-X NIL) (LOGSCALE-Y NIL) (BOX-WIDTH NIL) &ALLOW-OTHER-KEYS) + (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. @@ -1072,7 +1073,7 @@ (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. diff -r 72093637ac8b -r 71b34a9a3413 package.lisp --- a/package.lisp Fri Mar 01 14:51:11 2019 -0500 +++ b/package.lisp Fri Mar 08 22:09:23 2019 -0500 @@ -331,6 +331,7 @@ :collect-set :cycling :every-nth + :finding-all :for-nested :in-array :in-hashset @@ -348,13 +349,13 @@ :real-time :recursively :run-time + :seed :since-start-into :skip-origin :test + :then :timing :within-radius - :seed - :then )) diff -r 72093637ac8b -r 71b34a9a3413 src/gnuplot.lisp --- 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. diff -r 72093637ac8b -r 71b34a9a3413 src/iterate.lisp --- 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))))))))