--- a/src/clos.lisp Fri Aug 05 00:04:27 2022 -0400
+++ b/src/clos.lisp Wed Feb 08 20:40:37 2023 -0500
@@ -45,3 +45,11 @@
,(mapcar (curry #'build-slot-definition conc-name) slots)
,@options)))
+
+
+(defmacro ensure-slot-value (object slot &optional default)
+ "Return the `slot-value` of `slot` in `object`, setting it to `default` if unbound."
+ (alexandria:once-only (object slot)
+ `(if (slot-boundp ,object ,slot)
+ (slot-value ,object ,slot)
+ (setf (slot-value ,object ,slot) ,default))))
--- a/src/control-flow.lisp Fri Aug 05 00:04:27 2022 -0400
+++ b/src/control-flow.lisp Wed Feb 08 20:40:37 2023 -0500
@@ -418,7 +418,8 @@
`(dotimes (,(gensym) ,n)
,@body))
-(defmacro do-vector ((var-or-vars vector) &body body)
+(defmacro do-vector
+ ((var-or-vars vector &key (start nil start?) (end nil end?)) &body body)
"Iterate over `vector`, performing `body` with `var-or-vars` bound.
`var-or-vars` can be one of the following:
@@ -434,19 +435,20 @@
Returns `nil`.
"
- (setf var-or-vars (alexandria:ensure-list var-or-vars))
- (alexandria:once-only (vector)
+ (setf var-or-vars (alexandria:ensure-list var-or-vars)
+ start (if start? start 0))
+ (alexandria:once-only (vector start)
(let ((i nil)
(v nil)
- (len (gensym "LEN")))
+ (end% (gensym "END")))
(ecase (length var-or-vars)
(1 (setf i (gensym "I")
v (first var-or-vars)))
(2 (setf i (first var-or-vars)
v (second var-or-vars))))
- `(do ((,len (length ,vector))
- (,i 0 (1+ ,i)))
- ((>= ,i ,len))
+ `(do ((,end% ,(if end? end `(length ,vector)))
+ (,i ,start (1+ ,i)))
+ ((>= ,i ,end%))
(let ((,v (aref ,vector ,i)))
,@body)))))
--- a/src/eldritch-horrors.lisp Fri Aug 05 00:04:27 2022 -0400
+++ b/src/eldritch-horrors.lisp Wed Feb 08 20:40:37 2023 -0500
@@ -71,3 +71,47 @@
"Just evaluate `body` all the time, jesus christ lisp."
`(eval-when (:compile-toplevel :load-toplevel :execute) ,@body))
+
+(defmacro scratch% (&body forms)
+ (assert (not (null forms)) () "Malformed scratch block, missing final expr.")
+ (destructuring-bind (head . forms) forms
+ (cond
+ ((null forms) head)
+ ((eql head :mv) (destructuring-bind (symbols expr . forms) forms
+ `(multiple-value-bind ,symbols ,expr
+ (scratch% ,@forms))))
+ ((eql head :db) (destructuring-bind (bindings expr . forms) forms
+ `(destructuring-bind ,bindings ,expr
+ (scratch% ,@forms))))
+ ((symbolp head) (destructuring-bind (expr . forms) forms
+ `(let ((,head ,expr))
+ (scratch% ,@forms))))
+ (t `(progn ,head (scratch% ,@forms))))))
+
+
+(defmacro scratch (&body forms)
+ "Evaluate `forms` in an imperative fashion.
+
+ Each expression in `forms` will be evaluated, with the following exceptions:
+
+ * A bare symbol will be bound via (nested) `let` to the next expression.
+ * `:mv` will bind the next expression (which must be a list of symbols) to the
+ expression after it with `multiple-value-bind`.
+ * `:db` will bind the next expression (which must be a valid binding) to the
+ expression after it with `destructuring-bind`.
+
+ Example:
+
+ (scratch
+ a 10
+ b 20
+ c (+ a b)
+ :mv (d e) (truncate 100 23)
+ :db (f (g)) (list 100 (list 22))
+ (+ a (- b c) d e (* f g)))
+
+ "
+ ;; Similar to `bb` described here:
+ ;; https://blog.rongarret.info/2023/01/lisping-at-jpl-revisited.html
+ `(block nil (scratch% ,@forms)))
+
--- a/src/gnuplot.lisp Fri Aug 05 00:04:27 2022 -0400
+++ b/src/gnuplot.lisp Wed Feb 08 20:40:37 2023 -0500
@@ -95,6 +95,15 @@
`commands` must be a string or a sequence of strings.
+ Example:
+
+ (gnuplot `((\"$data\" . ,foo-data)) \"
+ @xrfc3339
+ set terminal qt
+ plot $data using 1:2 with linespoints
+ pause mouse close
+ \")
+
"
(with-gnuplot ()
(dolist (d data)
--- a/src/package.lisp Fri Aug 05 00:04:27 2022 -0400
+++ b/src/package.lisp Wed Feb 08 20:40:37 2023 -0500
@@ -47,14 +47,16 @@
(:documentation "Utilities for working with CLOS.")
(:export
:defclass*
- :define-condition*))
+ :define-condition*
+ :ensure-slot-value))
(defpackage :losh.eldritch-horrors
(:use :cl :iterate :losh.base)
(:documentation "Abandon all hope, ye who enter here.")
(:export
:eval-dammit
- :define-with-macro))
+ :define-with-macro
+ :scratch))
(defpackage :losh.functions
(:use :cl :iterate :losh.base)
@@ -398,6 +400,8 @@
:take-while
:drop
:drop-while
+ :chunk
+ :ngrams
:summation
:product
:doseq
--- a/src/sequences.lisp Fri Aug 05 00:04:27 2022 -0400
+++ b/src/sequences.lisp Wed Feb 08 20:40:37 2023 -0500
@@ -237,6 +237,59 @@
(sequence (drop-while-seq predicate seq))))
+(defun-inline chunk-list (list chunk-size)
+ ;; Since lists have O(N) access time, we iterate through manually,
+ ;; collecting each chunk as we pass through it. Using SUBSEQ would
+ ;; be O(N^2).
+ (loop :while list
+ :collect (loop :repeat chunk-size :while list :collect (pop list))))
+
+(defun-inline chunk-sequence (sequence chunk-size)
+ ;; For other sequences like strings or arrays, we can simply chunk
+ ;; by repeated SUBSEQs.
+ (loop :with len := (length sequence)
+ :for i :below len :by chunk-size
+ :collect (subseq sequence i (min len (+ chunk-size i)))))
+
+(defun chunk (sequence chunk-size)
+ "Split `sequence` into a list of subsequences of size `chunk-size`.
+
+ The final chunk may be smaller than `chunk-size` if the length of `sequence`
+ is not evenly divisible by `chunk-size`.
+
+ "
+ ;; Based on `subdivide` from http://quickutil.org/
+ (check-type sequence sequence)
+ (check-type chunk-size (integer 1))
+ (etypecase sequence
+ (list (chunk-list sequence chunk-size))
+ (sequence (chunk-sequence sequence chunk-size))))
+
+
+(defun-inline ngrams-list (n list)
+ (loop :repeat (1+ (- (length list) n))
+ :for l :on list
+ :collect (take-list n l)))
+
+(defun-inline ngrams-sequence (n sequence)
+ (loop :for i :to (- (length sequence) n)
+ :collect (subseq sequence i (+ i n))))
+
+(defun ngrams (n sequence)
+ "Return a list of the `n`grams of `sequence`.
+
+ The length of `sequence` must be at least `n`.
+
+ "
+ ;; Based on `n-grams` from http://quickutil.org/
+ (check-type sequence sequence)
+ (check-type n (integer 1))
+ (assert (<= n (length sequence)))
+ (etypecase sequence
+ (list (ngrams-list n sequence))
+ (sequence (ngrams-sequence n sequence))))
+
+
(defun extrema (predicate sequence &key (key #'identity))
"Return the smallest and largest elements of `sequence` according to `predicate`.
@@ -520,3 +573,5 @@
`(defun ,name (,x ,y)
,(expand (cons predicate-spec more-predicate-specs))))))
+
+