Map at a subsequence of a list

Question

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}

Answer 1

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