Map at a subsequence of a list

I'm trying to construct a function somewhat similar to MapAt. A basic usage example should look like this:

list = {a, b, c, d};
MapAtSequence[f, list, 2;;3]
(* {a, f[b, c], d} *)


Or with specific numbers and functions

list = {1, 2, 3, 4};
MapAtSequence[Plus, list, 2;;3]
(* {1, 5, 4} *)


I'm not attached to the idea of using Span, a list of positions may also be ok, but so far I only have the need to apply a function to neighboring elements.

Here's my minimal working example:

MapAtSequence[f_, list_, span_] := Module[{l = list, output},
l[[span]] = f[Sequence @@ l[[span]]];
output = Drop[l, {(First@span) + 1, Last@span}]
]


This appears to work as intended, but is clearly good only for 1D lists. A pitfall awaits me if the applied function generates a list of the same length as the span (see somewhat related question). A similar pitfall awaits if my function generates a Sequence.

Moreover, I have a feeling this isn't an efficient or elegant way to get the job done. After all, at first glance the task sounds really simple - I need to splice a function into the list, for example go from this:

{a,      b, c , d} (* to this: *)
{a, Plus[b, c], d} (* <---|    *)


How can I improve my code and generalize it to multidimensional lists?

Edit:

For a certain set of functions such as Plus and Times my problem can be formulated in a simpler manner:

How can I replace some neighboring commas in a list to the infix notation of a function, e.g.:

{a, b,     c,     d, e}
{a, b~Plus~c~Plus~d, e}

• I am certain that this question has been asked before, if not here on Stack Overflow, though perhaps not in this detail. Can anyone find it? Mar 20, 2015 at 10:26
• Could well be, although I didn't manage to find this on SE initially. Googling is an art in its own right :) Mar 20, 2015 at 10:37

A pattern matching approach:

list = {a, b, c, d};

MapAtSequence1[f_, list_, span_] :=
list /. {Sequence @@ list[[;; Last@span]], e___} :>
{Sequence @@ list[[;; First@span - 1]], f @@ list[[span]], e}

MapAtSequence1[g, list, 2 ;; 4]


{a, g[b, c, d]}

An approach using Join

MapAtSequence2[f_, list_, span_] :=
list[[;; First@span - 1]]~Join~{f @@ list[[span]]}~Join~list[[Last@span + 1 ;;]]

MapAtSequence2[f, list, 3 ;; 4]


{a, b, f[c, d]}

(For this function the end of the Span must be given as an integer. Something like 2;; will not work as Last@span would be All.)

For multidimensional lists

MapAtSequence2[f_, list_, span_, sublist_] :=
MapAt[MapAtSequence2[f, #, span] &, list, {sublist}]

list = {{a, b, c, b, c, b, c, d}, {a, b, c, d, e, f, g}}
MapAtSequence2[f, list, 2 ;; 4, {1}]


{{a, f[b, c, b], c, b, c, d}, {a, b, c, d, e, f, g}}

and

MapAtSequence2[f, #, 3 ;; 4] & /@ list


{{a, b, f[c, b], c, b, c, d}, {a, b, f[c, d], e, f, g}}

One approach using Insert and Drop (improved according to the comment by Mr.Wizard)

MapAtSequence3[f_, list_, span_] :=
Insert[Drop[list, span], Unevaluated[f @@ list[[span]]], First@span]
MapAtSequence3[f_, list_, span_, sublist_] :=
MapAt[MapAtSequence3[f, #, span] &, list, sublist]


Or

MapAtSequence4[f_, list_, span_] := Module[{tL = list},
tL[[First@span]] = f @@ tL[[span]];
tL[[First@span + 1 ;; Last@span]] = Sequence[];
tL]
MapAtSequence4[f_, list_, span_, sublist_] :=
Module[{tL = list},
tL[[sublist, First@span]] = f @@ tL[[sublist, span]];
tL[[sublist, First@span + 1 ;; Last@span]] = Sequence[];
tL]


Benchmarking

1) List Length (Sequence Length 2)

list[n_] := list[n] = RandomInteger[10, n]
Do[list[n], {n, 1, 1000}]

benchListLength[mas_, maxLength_, span_] := Table[
{n, First@AbsoluteTiming@Do[mas[f, list[n], span], {1000}]},
{n, 3, maxLength}]

ListPlot[benchListLength[#, 1000, 2 ;; 3] & /@ {MapAtSequence1,
MapAtSequence2, MapAtSequence3, MapAtSequence4},
PlotRange -> All, Frame -> True,
FrameLabel -> {"List Length", "AbsoluteTiming of 1000 Runs"},
LabelStyle -> FontSize -> 12, ImageSize -> 450, PlotStyle -> AbsolutePointSize[7],
PlotLegends -> Placed[PointLegend[{MapAtSequence1, MapAtSequence2, MapAtSequence3,
MapAtSequence4}, LegendMarkerSize -> 7], {After, Top}]


2) Sequence Length (List Length 1000)

benchSeqLength[mas_] := Table[
{n, First@AbsoluteTiming@Do[mas[f, list[1000], 2 ;; n], {1000}]},
{n, 3, 1000}]

ListPlot[benchSeqLength[#] & /@ {MapAtSequence1, MapAtSequence2,
MapAtSequence3, MapAtSequence4}, PlotRange -> All, Frame -> True,
FrameLabel -> {"Sequence Length", "AbsoluteTiming of 1000 Runs"},
LabelStyle -> FontSize -> 12, ImageSize -> 450, PlotStyle -> AbsolutePointSize[7],
PlotLegends -> Placed[PointLegend[{MapAtSequence1, MapAtSequence2, MapAtSequence3,
MapAtSequence4}, LegendMarkerSize -> 7], {After, Top}]


3) Very long lists

• I'm afraid, this is even worse than my approach. Consider list = {a, b, c, b, c, d}; list /. {s___, Sequence @@ list[[4 ;; 5]], e___} :> {s, f @@ list[[4 ;; 5]], e} which finds the required sequence at positions 2;;3 and replaces those. Mar 18, 2015 at 11:38
• However the approach using Join gets my upvote. The question of generalizing to multidimensional lists still remains, but one solution looks like using MapAt to select the necessary sublist with the function passed to MapAt being your version of MapAtSequence. Mar 18, 2015 at 11:46
• Note to other readers: Karstens's latest edit renders my first comment irrelevant. Mar 18, 2015 at 11:57
• I will only need to apply MapAtSequence within one list, so you could write something like MapAtNested[f_,list_, index_, span_] := MapAt[MapAtSequence[f,#,span]&,list,index]. Would you like to expand this to an answer or shall I? Mar 18, 2015 at 12:02
• You might consider: MapAtSequence3[f_, list_, span_] := Insert[Drop[list, span], Unevaluated[ f @@ list[[span]] ], First@span] -- this should handle additional forms that the current version does not. Mar 20, 2015 at 10:53