[elpa] externals/dash 624c501 306/439: Add `-table` and `-table-flat`

[Phillip Lord]

branch: externals/dash
commit 624c501a674a3d6e77331d84f59ffd8d14c53c02
Author: Matus Goljer <address@hidden>
Commit: Matus Goljer <address@hidden>

    Add `-table` and `-table-flat`
---
 README.md       |   47 ++++++++++++++++++++++++++++++++++++++-
 dash.el         |   66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 dev/examples.el |   15 ++++++++++++
 3 files changed, 127 insertions(+), 1 deletions(-)

diff --git a/README.md b/README.md
index 4b55241..5912c87 100644
--- a/README.md
+++ b/README.md
@@ -139,6 +139,8 @@ Operations dual to reductions, building lists from seed 
value rather than consum
 * [-cycle](#-cycle-list) `(list)`
 * [-pad](#-pad-fill-value-rest-lists) `(fill-value &rest lists)`
 * [-annotate](#-annotate-fn-list) `(fn list)`
+* [-table](#-table-fn-rest-lists) `(fn &rest lists)`
+* [-table-flat](#-table-flat-fn-rest-lists) `(fn &rest lists)`
 * [-first](#-first-pred-list) `(pred list)`
 * [-last](#-last-pred-list) `(pred list)`
 * [-first-item](#-first-item-list) `(list)`
@@ -1110,7 +1112,7 @@ second elements of each list, and so on. The lengths of 
the returned
 groupings are equal to the length of the shortest input list.
 
 If two lists are provided as arguments, return the groupings as a list
-of cons cells. Otherwise, return the groupings as a list of lists. 
+of cons cells. Otherwise, return the groupings as a list of lists.
 
 ```cl
 (-zip '(1 2 3) '(4 5 6)) ;; => '((1 . 4) (2 . 5) (3 . 6))
@@ -1161,6 +1163,49 @@ element of `list` paired with the unmodified element of 
`list`.
 (--annotate (< 1 it) '(0 1 2 3)) ;; => '((nil . 0) (nil . 1) (t . 2) (t . 3))
 ```
 
+#### -table `(fn &rest lists)`
+
+Compute outer product of `lists` using function `fn`.
+
+The function `fn` should have the same arity as the number of
+supplied lists.
+
+The outer product is computed by applying fn to all possible
+combinations created by taking one element from each list in
+order.  The dimension of the result is (length lists).
+
+See also: `-table-flat`.
+
+```cl
+(-table '* '(1 2 3) '(1 2 3)) ;; => '((1 2 3) (2 4 6) (3 6 9))
+(-table (lambda (a b) (-sum (-zip-with '* a b))) '((1 2) (3 4)) '((1 3) (2 
4))) ;; => '((7 15) (10 22))
+(apply '-table 'list (-repeat 3 '(1 2))) ;; => '((((1 1 1) (2 1 1)) ((1 2 1) 
(2 2 1))) (((1 1 2) (2 1 2)) ((1 2 2) (2 2 2))))
+```
+
+#### -table-flat `(fn &rest lists)`
+
+Compute flat outer product of `lists` using function `fn`.
+
+The function `fn` should have the same arity as the number of
+supplied lists.
+
+The outer product is computed by applying fn to all possible
+combinations created by taking one element from each list in
+order.  The results are flattened, ignoring the tensor structure
+of the result.  This is equivalent to calling:
+
+    (-flatten-n (1- (length lists)) (-table fn lists))
+
+but the implementation here is much more efficient.
+
+See also: `-flatten-n`, `-table`.
+
+```cl
+(-table-flat 'list '(1 2 3) '(a b c)) ;; => '((1 a) (2 a) (3 a) (1 b) (2 b) (3 
b) (1 c) (2 c) (3 c))
+(-table-flat '* '(1 2 3) '(1 2 3)) ;; => '(1 2 3 2 4 6 3 6 9)
+(apply '-table-flat 'list (-repeat 3 '(1 2))) ;; => '((1 1 1) (2 1 1) (1 2 1) 
(2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2))
+```
+
 #### -first `(pred list)`
 
 Returns the first x in `list` where (`pred` x) is non-nil, else nil.
diff --git a/dash.el b/dash.el
index a411e60..ff464e0 100644
--- a/dash.el
+++ b/dash.el
@@ -847,6 +847,69 @@ element of LIST paired with the unmodified element of 
LIST."
   (declare (debug (form form)))
   `(-annotate (lambda (it) ,form) ,list))
 
+(defun dash--table-carry (lists restore-lists &optional re)
+  "Helper for `-table' and `-table-flat'.
+
+If a list overflows, carry to the right and reset the list.
+
+Return how many lists were re-seted."
+  (while (and (not (car lists))
+              (not (equal lists '(nil))))
+    (setcar lists (car restore-lists))
+    (pop (cadr lists))
+    (!cdr lists)
+    (!cdr restore-lists)
+    (when re
+      (push (nreverse (car re)) (cadr re))
+      (setcar re nil)
+      (!cdr re))))
+
+(defun -table (fn &rest lists)
+  "Compute outer product of LISTS using function FN.
+
+The function FN should have the same arity as the number of
+supplied lists.
+
+The outer product is computed by applying fn to all possible
+combinations created by taking one element from each list in
+order.  The dimension of the result is (length lists).
+
+See also: `-table-flat'."
+  (let ((restore-lists (copy-sequence lists))
+        (last-list (last lists))
+        (re (--map nil (number-sequence 1 (length lists)))))
+    (while (car last-list)
+      (let ((item (apply fn (-map 'car lists))))
+        (push item (car re))
+        (pop (car lists))
+        (dash--table-carry lists restore-lists re)))
+    (nreverse (car (last re)))))
+
+(defun -table-flat (fn &rest lists)
+  "Compute flat outer product of LISTS using function FN.
+
+The function FN should have the same arity as the number of
+supplied lists.
+
+The outer product is computed by applying fn to all possible
+combinations created by taking one element from each list in
+order.  The results are flattened, ignoring the tensor structure
+of the result.  This is equivalent to calling:
+
+    (-flatten-n (1- (length lists)) (-table fn lists))
+
+but the implementation here is much more efficient.
+
+See also: `-flatten-n', `-table'."
+  (let ((restore-lists (copy-sequence lists))
+        (last-list (last lists))
+        re)
+    (while (car last-list)
+      (push (apply fn (-map 'car lists)) re)
+      (pop (car lists))
+      (dash--table-carry lists restore-lists))
+    (nreverse re)))
+
 (defun -partial (fn &rest args)
   "Takes a function FN and fewer than the normal arguments to FN,
 and returns a fn that takes a variable number of additional ARGS.
@@ -1398,6 +1461,7 @@ structure such as plist or alist."
                              "-replace-where"
                              "--replace-where"
                              "-flatten"
+                             "-flatten-n"
                              "-concat"
                              "-mapcat"
                              "--mapcat"
@@ -1472,6 +1536,8 @@ structure such as plist or alist."
                              "-zip-with"
                              "--zip-with"
                              "-zip"
+                             "-table"
+                             "-table-flat"
                              "-partial"
                              "-elem-index"
                              "-elem-indices"
diff --git a/dev/examples.el b/dev/examples.el
index ef9c3b8..4de5882 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -469,6 +469,21 @@
     (-annotate 'length '(("h" "e" "l" "l" "o") ("hello" "world"))) => '((5 . 
("h" "e" "l" "l" "o")) (2 . ("hello" "world")))
     (--annotate (< 1 it) '(0 1 2 3)) => '((nil . 0) (nil . 1) (t . 2) (t . 3)))
 
+  (defexamples -table
+    (-table '* '(1 2 3) '(1 2 3)) => '((1 2 3) (2 4 6) (3 6 9))
+    (-table (lambda (a b) (-sum (-zip-with '* a b))) '((1 2) (3 4)) '((1 3) (2 
4))) => '((7 15) (10 22))
+    (apply '-table 'list (-repeat 3 '(1 2))) => '((((1 1 1) (2 1 1)) ((1 2 1) 
(2 2 1))) (((1 1 2) (2 1 2)) ((1 2 2) (2 2 2)))))
+
+  (defexamples -table-flat
+    (-table-flat 'list '(1 2 3) '(a b c)) => '((1 a) (2 a) (3 a) (1 b) (2 b) 
(3 b) (1 c) (2 c) (3 c))
+    (-table-flat '* '(1 2 3) '(1 2 3)) => '(1 2 3 2 4 6 3 6 9)
+    (apply '-table-flat 'list (-repeat 3 '(1 2))) => '((1 1 1) (2 1 1) (1 2 1) 
(2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2))
+
+    ;; flatten law tests
+    (-flatten-n 1 (-table 'list '(1 2 3) '(a b c))) => '((1 a) (2 a) (3 a) (1 
b) (2 b) (3 b) (1 c) (2 c) (3 c))
+    (-flatten-n 1 (-table '* '(1 2 3) '(1 2 3))) => '(1 2 3 2 4 6 3 6 9)
+    (-flatten-n 2 (apply '-table 'list (-repeat 3 '(1 2)))) => '((1 1 1) (2 1 
1) (1 2 1) (2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2)))
+
   (defexamples -first
     (-first 'even? '(1 2 3)) => 2
     (-first 'even? '(1 3 5)) => nil