Operator currying: how to convert f[a,b][c,d] to {a+c,b+d}?

Question

This question is related to this golfing question (but I'm not interested in golfing, only in functional operator composition):

How can we convert f[a,b][c,d] to {a+c,b+d} using only operator forms and function compositions?

So far I've figured out two ways of converting f[a][b] to a+b:

Apply[Curry[Plus]] ~ Operate ~ f[a][b]
(*    a + b    *)

Plus @@ Apply[Curry[List]] ~ Operate ~ f[a][b]
(*    a + b    *)

but I'm stumped by the double-argument forms of the first problem, which interferes with currying. Do you know how to solve this?

Answer 1

Both Operate and Curry don't have access to the full expression, acting mostly on the head. This is why both of them take the depth as an optional argument, to know where to stop, since there is no other way for them to know - their modus operandi is limited to a single interation of evaluation sequence.

What you can do is something like this:

curry[expr_, _, 0]:=expr;

curry[head_Symbol, combiner_, n_:2][args___] := 
  curry[head[], combiner, n][args];

curry[head_[prev___], combiner_, n_][args___] := 
  curry[head[prev, combiner[args]], combiner, n-1]

which then can be used as:

Operate[Apply[curry[List, Plus]], f[a, b][c, d]]

(* {a + b, c + d} *)

But in a more complex case like e.g. f[a, b][c, d][e, f], you would have to manually set the depth for both Operate and curry:

Operate[Apply[curry[List, Plus, 3]], f[a, b][c, d][e, f], 2]

(* {a + b, c + d, e + f} *)

Not sure how much this takes it away from the operator form paradigm you fancy, but I don't how this could be done much differently, without using some hacks (such as using the Stack), which essentially would still serve to get a hold on entire expression rather than just its left-most head.

Answer 2

Here is my approach built on RightComposition, Through and Curry.

myOp=Curry[FixedPoint,{1,2}][Through@*{Head,Apply[List]/*Sow}/*First]/*Reap/*(#[[2,1,;;-3]]&)/*Total

myOp @ f[a, b][c, d]
(* Out[]= {a + c, b + d} *)

Where does it come from?

First we define helper operators pipe and branch:

pipe = RightComposition;
branch = Through @* {##} &;

pipe is just an alias of RightComposition for faster typing.

branch will be used to distribute functions to arguments. e.g.

branch[f, g, h] @ a
(* Out[]= {f[a], g[a], h[a]} *)
branch[f, g, h] @@ {a, b}
(* Out[]= {f[a, b], g[a, b], h[a, b]} *)
branch[F, G, H] @@@ {{a, b}, {c, d, e}}
(* Out[]= {{F[a, b], G[a, b], H[a, b]}, {F[c, d, e], G[c, d, e], H[c, d, e]}} *)

Now we can define our desired operator as following:

myOp = pipe[
  branch[Head, pipe[Apply@List, Sow]] /* First // Curry[FixedPoint, {1, 2}]
  , Reap, #[[2, 1, ;; -3]] &, Total
  ]
(* Out[]= Curry[FixedPoint, {1, 2}][(Through@*{Head, Apply[List] /* Sow}) /* 
   First] /* Reap /* (#1[[2, 1, 1 ;; -3]] &) /* Total *)

Generate a lengthy example expression:

testExpr = 5 // pipe[
   Range
   , Map@branch[x, y]
   , Fold[Apply, F, #] &
   ]
(* Out[]= F[x[1], y[1]][x[2], y[2]][x[3], y[3]][x[4], y[4]][x[5], y[5]] *)

Using myOp on testExpr gives desired result:

testExpr // myOp
(* Out[]= {x[1] + x[2] + x[3] + x[4] + x[5],  y[1] + y[2] + y[3] + y[4] + y[5]} *)

Answer 3

One more approach, learned a bunch tackling this. Basically grab the arguments of the functions and Sow-ing them as lists, and then grabbing the Head (leaving the previous arguments behind) and repeating until having walked through all of the Head using NestWhile

Define

ff = (Sow[List @@ #]; Head[#]) &

and

funk[t_] := Plus @@ Last@Last@Reap@NestWhile[ff, t, Length[#] > 0 &];

Test

t = f[a, b][c, d][j, k][r, s];
funk@t
(*  {a + c + j + r, b + d + k + s}  *)

Again

tt = gg[a, b, c][d, e, g][q, r, s]
funk@tt

(* {a + d + q, b + e + r, c + g + s} *)

Answer 4

Not really what you're looking for, but another cute way to do this using the fact that a pure-function captures its Head. We use an empty function call as a terminator for our threading process.

threader =
  If[Length[{##}] > 0, 
    Insert[#0, {##}, {1, 3, 2, -1}],
    MapThread[Plus, {}]
    ] &;

threader[a, b][c, d][e, f][g, h][]

{a + c + e + g, b + d + f + h}

Note too that we could generalize this like:

threadable[f_]:=
  If[Length[{##}] > 0, 
    Insert[#0, {##}, {1, 3, 2, -1}],
    MapThread[f, {}]
    ] &;

threadable[Plus][a, b][c, d][e, f][g, h][]

{a + c + e + g, b + d + f + h}