diff --git a/README.md b/README.md index 5ce272e..0e73195 100644 --- a/README.md +++ b/README.md @@ -199,6 +199,7 @@ These combinators require Emacs 24 for its lexical scope. So they are offered in * [-orfn](#-orfn-rest-preds) `(&rest preds)` * [-andfn](#-andfn-rest-preds) `(&rest preds)` * [-iteratefn](#-iteratefn-fn-n) `(fn n)` +* [-prodfn](#-prodfn-rest-fns) `(&rest fns)` ## Anaphoric functions @@ -1687,6 +1688,27 @@ This function satisfies the following law: (funcall (-iteratefn 'cdr 3) '(1 2 3 4 5)) ;; => '(4 5) ``` +#### -prodfn `(&rest fns)` + +Take a list of n functions and return a function that takes a +list of length n, applying i-th function to i-th element of the +input list. Returns a list of length n. + +In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) + +This function satisfies the following laws: + + (-compose (-prodfn f g ...) (-prodfn f' g' ...)) = (-prodfn (-compose f f') (-compose g g') ...) + (-prodfn f g ...) = (-juxt (-compose f (-partial 'nth 0)) (-compose g (-partial 'nth 1)) ...) + (-compose (-prodfn f g ...) (-juxt f' g' ...)) = (-juxt (-compose f f') (-compose g g') ...) + (-compose (-partial 'nth n) (-prod f1 f2 ...)) = (-compose fn (-partial 'nth n)) + +```cl +(funcall (-prodfn '1+ '1- 'int-to-string) '(1 2 3)) ;; => '(2 1 "3") +(-map (-prodfn '1+ '1-) '((1 2) (3 4) (5 6) (7 8))) ;; => '((2 1) (4 3) (6 5) (8 7)) +(apply '+ (funcall (-prodfn 'length 'string-to-int) '((1 2 3) "15"))) ;; => 18 +``` + ## Contribute diff --git a/dash-functional.el b/dash-functional.el index bd77519..1faf172 100644 --- a/dash-functional.el +++ b/dash-functional.el @@ -135,6 +135,21 @@ This function satisfies the following law: (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))." (lambda (x) (--dotimes n (setq x (funcall fn x))) x)) +(defun -prodfn (&rest fns) + "Take a list of n functions and return a function that takes a +list of length n, applying i-th function to i-th element of the +input list. Returns a list of length n. + +In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) + +This function satisfies the following laws: + + (-compose (-prodfn f g ...) (-prodfn f' g' ...)) = (-prodfn (-compose f f') (-compose g g') ...) + (-prodfn f g ...) = (-juxt (-compose f (-partial 'nth 0)) (-compose g (-partial 'nth 1)) ...) + (-compose (-prodfn f g ...) (-juxt f' g' ...)) = (-juxt (-compose f f') (-compose g g') ...) + (-compose (-partial 'nth n) (-prod f1 f2 ...)) = (-compose fn (-partial 'nth n))" + (lambda (x) (-zip-with 'funcall fns x))) + (provide 'dash-functional) ;;; dash-functional.el ends here diff --git a/dev/examples.el b/dev/examples.el index 61a1365..9df65ba 100644 --- a/dev/examples.el +++ b/dev/examples.el @@ -725,4 +725,26 @@ (-last-item (-iterate fn init (1+ 3)))) (equal (funcall (-iteratefn fn 5) init) (-last-item (-iterate fn init (1+ 5))))))) + + (defexamples -prodfn + (funcall (-prodfn '1+ '1- 'int-to-string) '(1 2 3)) => '(2 1 "3") + (-map (-prodfn '1+ '1-) '((1 2) (3 4) (5 6) (7 8))) => '((2 1) (4 3) (6 5) (8 7)) + (apply '+ (funcall (-prodfn 'length 'string-to-int) '((1 2 3) "15"))) => 18 + (let ((f '1+) + (g '1-) + (ff 'string-to-int) + (gg 'length) + (input '(1 2)) + (input2 "foo") + (input3 '("10" '(1 2 3)))) + (equal (funcall (-prodfn f g) input) + (funcall (-juxt (-compose f (-partial 'nth 0)) (-compose g (-partial 'nth 1))) input)) + (equal (funcall (-compose (-prodfn f g) (-juxt ff gg)) input2) + (funcall (-juxt (-compose f ff) (-compose g gg)) input2)) + (equal (funcall (-compose (-partial 'nth 0) (-prod f g)) input) + (funcall (-compose f (-partial 'nth 0)) input)) + (equal (funcall (-compose (-partial 'nth 1) (-prod f g)) input) + (funcall (-compose g (-partial 'nth 1)) input)) + (equal (funcall (-compose (-prodfn f g) (-prodfn ff gg)) input3) + (funcall (-prodfn (-compose f ff) (-compose g gg)) input3)))) ))