72093637ac8b

Merge.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 01 Mar 2019 14:51:11 -0500
parents 9b6480080f38 (current diff) 3cf5a5efd686 (diff)
children 71b34a9a3413
branches/tags (none)
files

Changes

--- a/DOCUMENTATION.markdown	Mon Dec 24 01:51:06 2018 -0500
+++ b/DOCUMENTATION.markdown	Fri Mar 01 14:51:11 2019 -0500
@@ -24,16 +24,18 @@
 
 ### `BISECT-LEFT` (function)
 
-    (BISECT-LEFT PREDICATE VECTOR TARGET)
-
-Bisect `vector` based on `(predicate el target)` and return the LEFT element.
+    (BISECT-LEFT PREDICATE VECTOR TARGET &KEY (KEY #'IDENTITY) (START 0) (END (LENGTH VECTOR)))
+
+Bisect `vector` with `predicate` and return the LEFT element.
+
+  Only the subsequence of `vector` bounded by `start` and `end` is considered.
 
   `vector` must be sorted (with `predicate`) before this function is called
   (this is not checked).
 
   You can think of this function as partitioning the elements into two halves:
-  those that satisfy `(predicate el target)` and those that don't, and then
-  selecting the element on the LEFT side of the split:
+  those that satisfy `(predicate (funcall key element) target)` and those that
+  don't, and then selecting the element on the LEFT side of the split:
 
       satisfying  not statisfying
     #(..........  ...............)
@@ -46,28 +48,32 @@
 
   Examples:
 
-    ;                 index
-    ;              0 1 2 3 4 5          val  index
-    (bisect #'<  #(1 3 5 7 7 9) 5) ; =>   3, 1
-    (bisect #'<= #(1 3 5 7 7 9) 5) ; =>   5, 2
-    (bisect #'<= #(1 3 5 7 7 9) 7) ; =>   7, 4
-    (bisect #'<  #(1 3 5 7 7 9) 1) ; => nil, nil
-    (bisect #'>  #(9 8 8 8 1 0) 5) ; =>   8, 3
+    ;                     index
+    ;                  0 1 2 3 4 5                                val  index
+    (bisect-left '<  #(1 3 5 7 7 9) 5)                     ; =>     3, 1
+    (bisect-left '<= #(1 3 5 7 7 9) 5)                     ; =>     5, 2
+    (bisect-left '<= #(1 3 5 7 7 9) 7)                     ; =>     7, 4
+    (bisect-left '<  #(1 3 5 7 7 9) 1)                     ; =>   nil, nil
+    (bisect-left '>  #(9 8 8 8 1 0) 5)                     ; =>     8, 3
+    (bisect-left '<  #((1) (2 2) (3 3 3)) 2 :key #'length) ; =>   (1), 0
+    (bisect-left '<= #((1) (2 2) (3 3 3)) 2 :key #'length) ; => (2 2), 1
 
   
 
 ### `BISECT-RIGHT` (function)
 
-    (BISECT-RIGHT PREDICATE VECTOR TARGET)
-
-Bisect `vector` based on `(predicate el target)` and return the RIGHT element.
+    (BISECT-RIGHT PREDICATE VECTOR TARGET &KEY (KEY #'IDENTITY) (START 0) (END (LENGTH VECTOR)))
+
+Bisect `vector` with `predicate` and return the RIGHT element.
+
+  Only the subsequence of `vector` bounded by `start` and `end` is considered.
 
   `vector` must be sorted (with `predicate`) before this function is called
   (this is not checked).
 
   You can think of this function as partitioning the elements into two halves:
-  those that satisfy `(predicate el target)` and those that don't, and then
-  selecting the element on the RIGHT side of the split:
+  those that satisfy `(predicate (funcall key element) target)` and those that
+  don't, and then selecting the element on the RIGHT side of the split:
 
       satisfying  not statisfying
     #(..........  ...............)
@@ -80,13 +86,15 @@
 
   Examples:
 
-    ;                 index
-    ;               0 1 2 3 4 5           val  index
-    (rbisect #'<  #(1 3 5 7 7 9) 5)  ; =>   5, 2
-    (rbisect #'<= #(1 3 5 7 7 9) 5)  ; =>   7, 3
-    (rbisect #'<= #(1 3 5 7 7 9) 7)  ; =>   9, 5
-    (rbisect #'<  #(1 3 5 7 7 9) 10) ; => nil, nil
-    (rbisect #'>  #(9 8 8 8 1 0) 5)  ; =>   1, 4
+    ;                       index
+    ;                   0 1 2 3 4 5                                  val  index
+    (bisect-right '<  #(1 3 5 7 7 9) 5)                     ; =>       5, 2
+    (bisect-right '<= #(1 3 5 7 7 9) 5)                     ; =>       7, 3
+    (bisect-right '<= #(1 3 5 7 7 9) 7)                     ; =>       9, 5
+    (bisect-right '<  #(1 3 5 7 7 9) 10)                    ; =>     nil, nil
+    (bisect-right '>  #(9 8 8 8 1 0) 5)                     ; =>       1, 4
+    (bisect-right '<  #((1) (2 2) (3 3 3)) 2 :key #'length) ; =>   (2 2), 1
+    (bisect-right '<= #((1) (2 2) (3 3 3)) 2 :key #'length) ; => (3 3 3), 2
 
   
 
@@ -313,6 +321,35 @@
 
 Thread the given forms, with `<>` as a placeholder.
 
+### `DO-IRANGE` (macro)
+
+    (DO-IRANGE RANGES
+      &BODY
+      BODY)
+
+Perform `body` on the given inclusive `ranges`.
+
+  Each range in `ranges` should be of the form `(variable from to)`.  During
+  iteration `body` will be executed with `variable` bound to successive values
+  in the range [`from`, `to`].
+
+  If multiple ranges are given they will be iterated in a nested fashion.
+
+  Example:
+
+    (do-irange ((x  0  2)
+                (y 10 11))
+      (pr x y))
+    ; =>
+    ; 0 10
+    ; 0 11
+    ; 1 10
+    ; 1 11
+    ; 2 10
+    ; 2 11
+
+  
+
 ### `DO-RANGE` (macro)
 
     (DO-RANGE RANGES
@@ -463,7 +500,7 @@
 
   This macro combines `if` and `let`.  It takes a list of bindings and binds
   them like `let` before executing the `then` branch of `body`, but if any
-  binding's value evaluate to `nil` the process stops there and the `else`
+  binding's value evaluates to `nil` the process stops there and the `else`
   branch is immediately executed (with no bindings in effect).
 
   If any `optional-declarations` are included they will only be in effect for
@@ -779,12 +816,6 @@
 
   
 
-### `PHT` (function)
-
-    (PHT HASH-TABLE &OPTIONAL (STREAM T))
-
-Synonym for `print-hash-table` for less typing at the REPL.
-
 ### `PR` (function)
 
     (PR &REST ARGS)
@@ -798,25 +829,9 @@
 
   
 
-### `PRINT-HASH-TABLE` (function)
-
-    (PRINT-HASH-TABLE HASH-TABLE &OPTIONAL (STREAM T))
-
-Print a pretty representation of `hash-table` to `stream.`
-
-  Respects `*print-length*` when printing the elements.
-
-  
-
-### `PRINT-HASH-TABLE-CONCISELY` (function)
-
-    (PRINT-HASH-TABLE-CONCISELY HASH-TABLE &OPTIONAL (STREAM T))
-
-Print a concise representation of `hash-table` to `stream.`
-
-  Should respect `*print-length*` when printing the elements.
-
-  
+### `PRETTY-PRINT-HASH-TABLE` (function)
+
+    (PRETTY-PRINT-HASH-TABLE *STANDARD-OUTPUT* HT)
 
 ### `PRINT-TABLE` (function)
 
@@ -957,14 +972,71 @@
 
 Utilities for working with higher-order functions.
 
+### `FIXED-POINT` (function)
+
+    (FIXED-POINT FUNCTION DATA &KEY (TEST 'EQL) (LIMIT NIL))
+
+Find a fixed point of `function`, starting with `data`.
+
+  Successive runs of `function` will be compared with `test`.  Once `test`
+  returns true the last result will be returned.
+
+  `limit` can be an integer to limit the maximum number of iterations performed.
+
+  A second value is also returned: `t` if a fixed point was found or `nil` if
+  the iteration limit was reached.
+
+  
+
+### `JUXT` (function)
+
+    (JUXT &REST FUNCTIONS)
+
+Return a function that will juxtapose the results of `functions`.
+
+  This is like Clojure's `juxt`.  Given functions `(f0 f1 ... fn)`, this will
+  return a new function which, when called with some arguments, will return
+  `(list (f0 ...args...) (f1 ...args...) ... (fn ...args...))`.
+
+  Example:
+
+    (funcall (juxt #'list #'+ #'- #'*) 1 2)
+    => ((1 2) 3 -1 2)
+
+  
+
+### `NULLARY` (function)
+
+    (NULLARY FUNCTION &OPTIONAL RESULT)
+
+Return a new function that acts as a nullary-patched version of `function`.
+
+  The new function will return `result` when called with zero arguments, and
+  delegate to `function` otherwise.
+
+  Examples:
+
+    (max 1 10 2) ; => 10
+    (max)        ; => invalid number of arguments
+
+    (funcall (nullary #'max))          ; => nil
+    (funcall (nullary #'max 0))        ; => 0
+    (funcall (nullary #'max 0) 1 10 2) ; => 10
+
+    (reduce #'max nil)                  ; => invalid number of arguments
+    (reduce (nullary #'max) nil)        ; => nil
+    (reduce (nullary #'max :empty) nil) ; => :empty
+    (reduce (nullary #'max) '(1 10 2))  ; => 10
+
+  
+
 ## Package `LOSH.GNUPLOT`
 
 Utilities for plotting data with gnuplot.
 
 ### `GNUPLOT` (function)
 
-    (GNUPLOT DATA &REST ARGS &KEY (X #'CAR) (Y #'CDR) (SPEW-OUTPUT NIL)
-             &ALLOW-OTHER-KEYS)
+    (GNUPLOT DATA &REST ARGS &KEY (X #'CAR) (Y #'CDR) (SPEW-OUTPUT NIL) &ALLOW-OTHER-KEYS)
 
 Plot `data` to `filename` with gnuplot.
 
@@ -983,12 +1055,10 @@
 
 ### `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) (GRAPH-TITLE) (LOGSCALE-X NIL) (LOGSCALE-Y NIL)
-                  (BOX-WIDTH NIL) &ALLOW-OTHER-KEYS)
+    (GNUPLOT-ARGS &KEY (OUTPUT :WXT) (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)
 
 Return the formatted command line arguments for the given gnuplot arguments.
 
@@ -997,20 +1067,10 @@
 
   
 
-### `GNUPLOT-EXPR` (macro)
-
-    (GNUPLOT-EXPR EXPR &REST ARGS)
-
-Plot `expr` (an expression involving `x`) with gnuplot.
-
-  See the docstring of `gnuplot-args` for other keyword arguments.
-
-  
-
 ### `GNUPLOT-FUNCTION` (function)
 
-    (GNUPLOT-FUNCTION FUNCTION &REST ARGS &KEY (START 0.0) (END 1.0) (STEP 0.1)
-                      (INCLUDE-END NIL) &ALLOW-OTHER-KEYS)
+    (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.
 
@@ -1022,7 +1082,7 @@
 
 ### `GNUPLOT-HISTOGRAM` (function)
 
-    (GNUPLOT-HISTOGRAM DATA &KEY (BIN-WIDTH 1) SPEW-OUTPUT)
+    (GNUPLOT-HISTOGRAM DATA &REST ARGS &KEY (BIN-WIDTH 1) &ALLOW-OTHER-KEYS)
 
 Plot `data` as a histogram with gnuplot.
 
@@ -1244,6 +1304,12 @@
 
 Utilities for input/output/reading/etc.
 
+### `READ-ALL` (function)
+
+    (READ-ALL STREAM)
+
+Read all forms from `stream` and return them as a fresh list.
+
 ### `READ-ALL-FROM-FILE` (function)
 
     (READ-ALL-FROM-FILE PATH)
@@ -1675,8 +1741,7 @@
 
 ### `RANDOM-GAUSSIAN-INTEGER` (function)
 
-    (RANDOM-GAUSSIAN-INTEGER MEAN STANDARD-DEVIATION &OPTIONAL
-                             (GENERATOR #'RANDOM))
+    (RANDOM-GAUSSIAN-INTEGER MEAN STANDARD-DEVIATION &OPTIONAL (GENERATOR #'RANDOM))
 
 Return a random integer from a gaussian distribution.  NOT THREAD-SAFE (yet)!
 
@@ -1863,18 +1928,30 @@
 
 ### `PRODUCT` (function)
 
-    (PRODUCT SEQUENCE &KEY KEY)
+    (PRODUCT SEQUENCE &KEY KEY (INITIAL-VALUE 1) MODULO)
 
 Return the product of all elements of `sequence`.
 
   If `key` is given, it will be called on each element to compute the
   multiplicand.
 
+  If `initial-value` is given, it will be used instead of 1 to seed the
+  multiplication.
+
+  If `modulo` is given the successive products will be modulo'ed by it along the
+  way, which can prevent the need for bignums if you don't need the full result.
+
   Examples:
 
     (product #(1 2 3))
     ; => 6
 
+    (product #(1 2 3) :modulo 5)
+    ; => 1
+
+    (product #(1 2 3) :modulo 5 :initial-value 2)
+    ; => 2
+
     (product '("1" "2" "3") :key #'parse-integer)
     ; => 6
 
@@ -1906,14 +1983,33 @@
 
   
 
+### `STRING-JOIN` (function)
+
+    (STRING-JOIN SEPARATOR SEQUENCE)
+
+Join a `sequence` of objects into a string, separated by `separator`.
+
+  All objects in `sequence` (and `separator`) will be `princ-to-string`ed before
+  joining.
+
+  This is implemented simply, not efficiently, so consider implementing your own
+  if you're joining a lot of stuff.
+
+  
+
 ### `SUMMATION` (function)
 
-    (SUMMATION SEQUENCE &KEY KEY)
+    (SUMMATION SEQUENCE &KEY KEY (INITIAL-VALUE 0) MODULO)
 
 Return the sum of all elements of `sequence`.
 
   If `key` is given, it will be called on each element to compute the addend.
 
+  If `initial-value` is given, it will be used instead of 0 to seed the addition.
+
+  If `modulo` is given the successive sums will be modulo'ed by it along the
+  way, which can prevent the need for bignums if you don't need the full result.
+
   This function's ugly name was chosen so it wouldn't clash with iterate's `sum`
   symbol.  Sorry.
 
--- a/losh.asd	Mon Dec 24 01:51:06 2018 -0500
+++ b/losh.asd	Fri Mar 01 14:51:11 2019 -0500
@@ -54,7 +54,9 @@
                                                  "hash-tables"))
 
                  (:file "iterate" :depends-on ("control-flow"
-                                               "sequences"))
+                                               "sequences"
+                                               "iterate-pre"
+                                               "hash-sets"))
                  (:file "gnuplot" :depends-on ("control-flow"
                                                "debugging"
                                                "sequences"))
--- a/package.lisp	Mon Dec 24 01:51:06 2018 -0500
+++ b/package.lisp	Fri Mar 01 14:51:11 2019 -0500
@@ -82,6 +82,7 @@
   (:use :cl :iterate :losh.quickutils)
   (:documentation "Utilities for input/output/reading/etc.")
   (:export
+    :read-all
     :read-all-from-file
     :read-all-from-string))
 
@@ -317,6 +318,7 @@
 (defpackage :losh.iterate
   (:use :cl :iterate :losh.quickutils
     :losh.iterate-pre
+    :losh.hash-sets
     :losh.control-flow ;; always needed because we need a single RECURSIVELY symbol
     :losh.sequences)
   (:documentation "Custom `iterate` drivers and clauses.")
@@ -326,6 +328,7 @@
     :anding
     :averaging
     :collect-hash
+    :collect-set
     :cycling
     :every-nth
     :for-nested
@@ -350,6 +353,8 @@
     :test
     :timing
     :within-radius
+    :seed
+    :then
 
     ))
 
--- a/src/clos.lisp	Mon Dec 24 01:51:06 2018 -0500
+++ b/src/clos.lisp	Fri Mar 01 14:51:11 2019 -0500
@@ -5,13 +5,17 @@
                             (type nil type?)
                             (documentation nil documentation?)
                             (initform nil initform?)
-                            (accessor (symb conc-name name))
+                            (allocation nil allocation?)
+                            (accessor (if conc-name
+                                        (symb conc-name name)
+                                        name))
                             (initarg (ensure-keyword name)))
       (ensure-list slot-spec)
     `(,name
       :initarg ,initarg
       :accessor ,accessor
       ,@(when initform? `(:initform ,initform))
+      ,@(when allocation? `(:allocation ,allocation))
       ,@(when type? `(:type ,type))
       ,@(when documentation? `(:documentation ,documentation)))))
 
--- a/src/eldritch-horrors.lisp	Mon Dec 24 01:51:06 2018 -0500
+++ b/src/eldritch-horrors.lisp	Fri Mar 01 14:51:11 2019 -0500
@@ -49,7 +49,7 @@
   (destructuring-bind (type &key (conc-name (symb type '-)))
       (ensure-list type-and-options)
     (let* ((accessors (loop :for slot :in slots
-                            :collect (symb conc-name slot)))
+                            :collect (if conc-name (symb conc-name slot) slot)))
            (symbol-args (loop :for slot :in slots
                               :collect (symb slot '-symbol)))
            (macro-name (symb 'with- type))
--- a/src/io.lisp	Mon Dec 24 01:51:06 2018 -0500
+++ b/src/io.lisp	Fri Mar 01 14:51:11 2019 -0500
@@ -1,5 +1,11 @@
 (in-package :losh.io)
 
+(defun read-all (stream)
+  "Read all forms from `stream` and return them as a fresh list."
+  (iterate
+    (for v :in-stream stream)
+    (collect v)))
+
 (defun read-all-from-string (string)
   "Read all forms from `string` and return them as a fresh list."
   (iterate
@@ -14,10 +20,4 @@
 (defun read-all-from-file (path)
   "Read all forms from the file at `path` and return them as a fresh list."
   (with-open-file (file path :direction :input)
-    (iterate
-      (with done = (gensym))
-      (for form = (read file nil done))
-      (while (not (eq form done)))
-      (collect form))))
-
-
+    (read-all file)))
--- a/src/iterate.lisp	Mon Dec 24 01:51:06 2018 -0500
+++ b/src/iterate.lisp	Fri Mar 01 14:51:11 2019 -0500
@@ -596,6 +596,28 @@
          (with ,hash-table = (make-hash-table :test ,test))
          (setf (gethash ,key ,hash-table) ,value)))))
 
+(defmacro-clause (COLLECT-SET element &optional
+                  INTO var
+                  TEST (test '#'eql))
+  "Collect elements into a hash set at `var`.
+
+  If `var` is omitted the hash set will be returned instead.
+
+  `test` specifies the test used for the hash set.
+
+  Example:
+
+    (iterate (for y :in '(a b a))
+             (collect-set y))
+    ; => {a b}
+
+  "
+  (let ((hash-set (or var iterate::*result-var*)))
+    `(progn
+       (with ,hash-set = (make-hash-set :test ,test))
+       (hset-insert! ,hash-set ,element))))
+
+
 (defmacro-clause (ORING expr &optional INTO var)
   (let ((result (or var iterate::*result-var*)))
     `(reducing ,expr :by #'or :into ,result :initial-value nil)))
@@ -665,3 +687,29 @@
        (,kwd ,var = ,expr))))
 
 
+(defmacro-driver (FOR var SEED seed THEN then)
+  "Bind `var` to `seed` initially, then to `then` on every iteration.
+
+  This differs from `(FOR … FIRST … THEN …)` and `(FOR … INITIALLY … THEN …)`
+  because `then` is evaluated on every iteration, *including* the first.
+
+  Example:
+
+    (iterate
+      (repeat 3)
+      (for x :first     0 :then (1+ x))
+      (for y :initially 0 :then (1+ y))
+      (for z :seed      0 :then (1+ z))
+      (collect (list x y z)))
+    ; =>
+    ((0 0 1)
+     (1 1 2)
+     (2 2 3))
+
+  "
+  (let ((kwd (if generate 'generate 'for)))
+    `(progn
+       (,kwd ,var :next ,then)
+       (initially (setf ,var ,seed)))))
+
+
--- a/src/mutation.lisp	Mon Dec 24 01:51:06 2018 -0500
+++ b/src/mutation.lisp	Fri Mar 01 14:51:11 2019 -0500
@@ -50,7 +50,7 @@
 (define-modify-macro remainderf (divisor) rem
   "Remainder `place` by `divisor` in-place.")
 
-(define-modify-macro clampf (from to) clamp
+(define-modify-macro clampf (from to) losh.math:clamp
   "Clamp `place` between `from` and `to` in-place.")
 
 (define-modify-macro negatef () -