# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1675906837 18000
# Node ID b51a18850dc51df9953e27186d50864e65699adc
# Parent  461876acdff580f15e4c373bf20a03b3c06e1742
Add chunk, ngrams, ensure-slot-value, scratch

diff -r 461876acdff5 -r b51a18850dc5 src/clos.lisp
--- 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))))
diff -r 461876acdff5 -r b51a18850dc5 src/control-flow.lisp
--- 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)))))
 
diff -r 461876acdff5 -r b51a18850dc5 src/eldritch-horrors.lisp
--- 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)))
+
diff -r 461876acdff5 -r b51a18850dc5 src/gnuplot.lisp
--- 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)
diff -r 461876acdff5 -r b51a18850dc5 src/package.lisp
--- 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
diff -r 461876acdff5 -r b51a18850dc5 src/sequences.lisp
--- 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))))))
 
+
+