How to apply or map a list of functions to a list of data?

Question

Say I have a group of functions:

f1[a_] := a * -1;
f2[a_] := a * 100;
f3[a_] := a / 10.0;

and some data in a list:

data := Range[1, 20];

I would like to apply this group of functions to the data: the first function applied to the first item of data, the second to the second, and so on. Because there are more data elements than there are functions, the first function is also applied to the fourth data element, and so on.

A simple work-round is this:

Flatten[{f1[#[[1]]], f2[#[[2]]], f3[#[[3]]]}  & /@ Partition[data, 3]]

giving

{-1, 200, 0.3, -4, 500, 0.6, -7, 800, 0.9, -10, 1100, 1.2, -13, 1400, 
  1.5, -16, 1700, 1.8}

but this isn't an ideal solution: the slots have been 'hard-wired', and it wouldn't be possible to modify the list of functions easily.

Is there a Map-related function that could do this elegantly? I've not been able to discover it yet.

(This is a toy example, of course!)

Answer 1

Here's how you can do it in a simple way:

functionMap[funcs_List, data_] := Module[{fn = RotateRight[funcs]}, 
    First[(fn = RotateLeft[fn])][#] & /@ data]

Use it as:

functionMap[{f1, f2, f3}, Range[20]]
(* {f1[1], f2[2], f3[3], f1[4], f2[5], f3[6], f1[7], f2[8], f3[9], f1[10],
    f2[11], f3[12], f1[13], f2[14], f3[15], f1[16], f2[17], f3[18], f1[19], f2[20]} *)

Answer 2

Use PadRight with the cyclical padding setup:

funcs = {f1, f2, f3};
data = Range[1, 20];
MapThread[#1[#2] &, {PadRight[funcs, Length@data, funcs], data}]

or

MapThread[Compose, {PadRight[funcs, Length@data, funcs], data}]

{f1[1], f2[2], f3[3], f1[4], f2[5], f3[6], f1[7], f2[8], f3[9], f1[10], f2[11], f3[12], f1[13], f2[14], f3[15], f1[16], f2[17], f3[18], f1[19], f2[20]}

Answer 3

MapIndexed[{f1, f2, f3}[[Mod[First@#2, 3, 1]]][#1] &, data]

does what you want (thanks to Sjoerd for pointing out a silly inefficiency).

Answer 4

Another approach

#1@#2 & @@@ 
  Partition[Riffle[Range[20], {f1, f2, f3}, {1, -1, 2}], 2] 

Comparing with Acl's solution:

#1@#2 & @@@ 
  Partition[Riffle[Range[20], {f1, f2, f3}, {1, -1, 2}], 2] == 
 MapIndexed[{f1@#1, f2@#1, f3@#1}[[Mod[First@#2, 3, 1]]] &, data

==> True

Answer 5

Another approach is to use Outer, as follows

Flatten@Outer[#1[#2]&, {f1, f2, f3}, Range[1,5]]
(*
{f1[1], f1[2], f1[3], f1[4], f1[5], 
 f2[1], f2[2], f2[3], f2[4], f2[5],
 f3[1], f3[2], f3[3], f3[4], f3[5]}
*)

---

Unfortunately, Outer causes problems if the data points are vectors, for instance

Flatten@Outer[#1[#2] &, {f1, f2, f3}, {#, #} & /@ Range[1, 3]]

produces

{f1[1], f1[1], f1[2], f1[2], f1[3], f1[3], 
 f2[1], f2[1], f2[2], f2[2], f2[3], f2[3], 
 f3[1], f3[1], f3[2], f3[2], f3[3], f3[3]}

To work around this, you need to use the 3$^\text{rd}$ and subsequent parameters of Outer which are level specifications:

Outer[#1[#2] &, {f1, f2, f3}, {#, #} & /@ Range[1, 3], Infinity, 1] //
  Flatten
(*
{f1[{1, 1}], f1[{2, 2}], f1[{3, 3}], 
 f2[{1, 1}], f2[{2, 2}], f2[{3, 3}], 
 f3[{1, 1}], f3[{2, 2}], f3[{3, 3}]}
*)

Or, if you prefer

Outer[#1 @@ #2 &, {f1, f2, f3}, {#, #} & /@ Range[1, 3], Infinity, 1] //
  Flatten
(*
{f1[1, 1], f1[2, 2], f1[3, 3], 
 f2[1, 1], f2[2, 2], f2[3, 3], 
 f3[1, 1], f3[2, 2], f3[3, 3]}
*)

Answer 6

Another approach using Fold in combination with Sow/Reap:

Reap[Fold[(Sow[#[[1]][#2]]; RotateLeft[#]) &, {f1, f2, f3}, data];][[2, 1]]

Answer 7

Would the following qualify as elegant or not?

mapFunctions[funcs_, list_] := Module[{r = list, u},
  applyFunc[f_, l_, i_, t_] := 
   MapAt[f, l, Table[{u}, {u, i, Length[l], t}]];
  Do[r = applyFunc[funcs[[u]], r, u, Length[funcs]],
   {u, Length[funcs]}];
  Return[r];
  ]

which gives:

In[9]:= MapFunctions[{f1, f2, f3}, data]

Out[9]= {f1[1], f2[2], f3[3], f1[4], f2[5], f3[6], f1[7], f2[8], 
 f3[9], f1[10], f2[11], f3[12], f1[13], f2[14], f3[15], f1[16], 
 f2[17], f3[18], f1[19], f2[20]}

Answer 8

The most elegant solution - using Through:

In[1911]:= data // Through@*{f, g}
Out[1911]= {f[data], g[data]}

Since Mathematica 14 - see new function "Comap": https://reference.wolfram.com/language/ref/Comap.html

Answer 9

Step by step using BlockMap and Fold:

funcs = {f1, f2, f3};
rules = {{a_List, b_List} :> {Drop[a, Length@b - Length@a], b},
               m_?MatrixQ :> Splice@MapApply[#1@#2 &, Thread[m]]};
With[{m = 20, n = Length@funcs},
 p1 = BlockMap[Identity, Range[m], {n}];
 p2 = Replace[Join[p1, {Range[Max@p1 + 1, m]}], {} -> Nothing, {1}];
 p3 = Partition[Riffle[ConstantArray[funcs, Length@p2], p2], 2];
 Fold[ReplaceAll, p3, rules]
 ]

 (*{f1[1], f2[2], f3[3], f1[4], f2[5], f3[6], f1[7], f2[8], f3[9], 
  f1[10], f2[11], f3[12], f1[13], f2[14], f3[15], f1[16], f2[17], 
  f3[18], f1[19], f2[20]}*)

Answer 10

Using Query

f1[a_] := a * -1;
f2[a_] := a * 100;
f3[a_] := a / 10.0;

data = Partition[Range @ 18, 3]

Query[All, {1 -> f1, 2 -> f2, 3 -> f3}] @ data

{{-1, 200, 0.3}, {-4, 500, 0.6}, {-7, 800, 0.9}, {-10, 1100, 1.2}, {-13, 1400, 1.5}, {-16, 1700, 1.8}}

In a simple case like this we don't need the f - definitions:

Query[All, Thread[{1, 2, 3} -> {# * -1 &, # * 100 &, # / 10. &}]] @ data

This gives, of course, the same result.

Answer 11

Another version with restructuring:

funcs = {f1, f2, f3};
len = Length@funcs;
data = Range[1, 20];

Flatten[MapThread[Map, {funcs, Flatten[Partition[data, len, len, {1, 1}, Nothing], {2}]}], {2, 1}]

(* {f1[1], f2[2], f3[3], f1[4], f2[5], f3[6], f1[7], f2[8], f3[9], f1[10], 
    f2[11], f3[12], f1[13], f2[14], f3[15], f1[16], f2[17], f3[18], f1[19], f2[20]} *)