[elpa] externals/dash 63ec298 308/439: Merge pull request #92 from Fuco1/outer-product

[Phillip Lord]

branch: externals/dash
commit 63ec298d6e8edf6d8bfd320bc6ab862b0aa599fe
Merge: fb51f8f 00549e4
Author: Magnar Sveen <address@hidden>
Commit: Magnar Sveen <address@hidden>

    Merge pull request #92 from Fuco1/outer-product
    
    Outer product
---
 README.md       |   56 +++++++++++++++++++++++++++++++++++++++++
 dash.el         |   75 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 dev/examples.el |   23 +++++++++++++++++
 3 files changed, 154 insertions(+), 0 deletions(-)

diff --git a/README.md b/README.md
index 092aa55..34443e2 100644
--- a/README.md
+++ b/README.md
@@ -44,6 +44,7 @@ Include this in your emacs settings to get syntax 
highlighting:
 * [-map-when](#-map-when-pred-rep-list) `(pred rep list)`
 * [-map-indexed](#-map-indexed-fn-list) `(fn list)`
 * [-flatten](#-flatten-l) `(l)`
+* [-flatten-n](#-flatten-n-num-list) `(num list)`
 * [-concat](#-concat-rest-lists) `(&rest lists)`
 * [-mapcat](#-mapcat-fn-list) `(fn list)`
 * [-slice](#-slice-list-from-optional-to) `(list from &optional to)`
@@ -138,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)`
@@ -301,6 +304,16 @@ Takes a nested list `l` and returns its contents as a 
single, flat list.
 (-flatten '(1 2 (3 . 4))) ;; => '(1 2 (3 . 4))
 ```
 
+#### -flatten-n `(num list)`
+
+Flatten `num` levels of a nested `list`.
+
+```cl
+(-flatten-n 1 '((1 2) ((3 4) ((5 6))))) ;; => '(1 2 (3 4) ((5 6)))
+(-flatten-n 2 '((1 2) ((3 4) ((5 6))))) ;; => '(1 2 3 4 (5 6))
+(-flatten-n 3 '((1 2) ((3 4) ((5 6))))) ;; => '(1 2 3 4 5 6)
+```
+
 #### -concat `(&rest lists)`
 
 Returns a new list with the concatenation of the elements in the supplied 
`lists`.
@@ -1150,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 2e2eccf..4e214d0 100644
--- a/dash.el
+++ b/dash.el
@@ -275,6 +275,10 @@ through the REP function."
       (-mapcat '-flatten l)
     (list l)))
 
+(defun -flatten-n (num list)
+  "Flatten NUM levels of a nested LIST."
+  (-last-item (--iterate (--mapcat (-list it) it) list (1+ num))))
+
 (defun -concat (&rest lists)
   "Returns a new list with the concatenation of the elements in the supplied 
LISTS."
   (apply 'append lists))
@@ -843,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.
@@ -1394,6 +1461,7 @@ structure such as plist or alist."
                              "-replace-where"
                              "--replace-where"
                              "-flatten"
+                             "-flatten-n"
                              "-concat"
                              "-mapcat"
                              "--mapcat"
@@ -1468,6 +1536,13 @@ structure such as plist or alist."
                              "-zip-with"
                              "--zip-with"
                              "-zip"
+                             "-zip-fill"
+                             "-cycle"
+                             "-pad"
+                             "-annotate"
+                             "--annotate"
+                             "-table"
+                             "-table-flat"
                              "-partial"
                              "-elem-index"
                              "-elem-indices"
diff --git a/dev/examples.el b/dev/examples.el
index 9520f44..4de5882 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -48,6 +48,14 @@
     (-flatten '((1 (2 3) (((4 (5))))))) => '(1 2 3 4 5)
     (-flatten '(1 2 (3 . 4))) => '(1 2 (3 . 4)))
 
+  (defexamples -flatten-n
+    (-flatten-n 1 '((1 2) ((3 4) ((5 6))))) => '(1 2 (3 4) ((5 6)))
+    (-flatten-n 2 '((1 2) ((3 4) ((5 6))))) => '(1 2 3 4 (5 6))
+    (-flatten-n 3 '((1 2) ((3 4) ((5 6))))) => '(1 2 3 4 5 6)
+    (-flatten-n 0 '(3 4)) => '(3 4)
+    (-flatten-n 0 '((1 2) (3 4))) => '((1 2) (3 4))
+    (-flatten-n 0 '(((1 2) (3 4)))) => '(((1 2) (3 4))))
+
   (defexamples -concat
     (-concat '(1)) => '(1)
     (-concat '(1) '(2)) => '(1 2)
@@ -461,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