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

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.


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]} *)

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} *)