mapping function to sublist

Question

I've a list of lists like

list = {
 {a, b, c, d},
 {e, f, g, h},
 {i, j, k, l}
}

and would like to apply a function y to the middle two elements from the list, so the output should be:

{
 {a, y[b, c], d},
 {e, y[f, g], h},
 {i, y[j, k], l}
}

My current approach is doing

Map[{#[[1]], y[#[[2]], #[[3]]], #[[4]]} &, list]

However, the actual lists are long so I'd like to avoid typing out #[[1]], #[[4]] etc. (all elements left unchanged). How can I do this?

I tried MapAt but couldn't make it work.

Answer 1

You can wrap your function:

list1 = {{a, b, c, d}, {e, f, g, h}, {i, j, k, l}} ;
list2 = {{a, b, c, d1, d2}, {e, f, g, h1, h2}, {i, j, k, l1, l2}} ;

ClearAll[wrapper] ;
wrapper[function_][{a_, b_, c_, d__}] := {a, function[b, c], d}

Map[wrapper[y], list1]
Map[wrapper[y], list2]
(* {{a,y[b,c],d},{e,y[f,g],h},{i,y[j,k],l}} *)
(* {{a,y[b,c],d1,d2},{e,y[f,g],h1,h2},{i,y[j,k],l1,l2}} *)

TakeList can be used to partition into three parts:

ClearAll[wrapper] ;
wrapper[function_, start_, end_][list_] := Flatten[
    MapAt[
        Apply[function],
        TakeList[list, {start - 1, end - start + 1, All}],
        2
    ]
] /; end > start ;

Map[wrapper[y, 2, 3], list2]
Map[wrapper[y, 2, 4], list2]
Map[wrapper[y, 1, 3], list2]
(* {{a,y[b,c],d1,d2},{e,y[f,g],h1,h2},{i,y[j,k],l1,l2}} *)
(* {{a,y[b,c,d1],d2},{e,y[f,g,h1],h2},{i,y[j,k,l1],l2}} *)
(* {{y[a,b,c],d1,d2},{y[e,f,g],h1,h2},{y[i,j,k],l1,l2}} *)

Answer 2

Using pattern matching:

list /. {a_, b_, c_, d_} ->  {a, y[b, c], d}

Edit (applying pattern at level 1)

If the list is of length 4, you can apply pattern to sublists at level 1 only.

Replace[list, {a_, b_, c_, d_} :>   {a, y[b, c], d}, {1}]

---

Result

{{a, y[b, c], d}, {e, y[f, g], h}, {i, y[j, k], l}}

Answer 3

The following assumes that the function to apply (y in the original post) should be applied on a contiguous range of positions in each sublist.

MapColumn[func_, bounds : {start_, _}, array_] :=
  MapThread[
    Insert[#2, #1, start] &, 
    {Map[func, Take[array, All, bounds]], Drop[array, 0, bounds]}]

Given the test list,

list = {{a, b, c, d}, {e, f, g, h}, {i, j, k, l}}

we could do

MapColumn[y, {2, 3}, list]
(* {{a,y[{b,c}],d},{e,y[{f,g}],h},{i,y[{j,k}],l}} *)

or, to more exactly match the expected output provided,

MapColumn[Apply[y], {2, 3}, list]
(* {{a,y[b,c],d},{e,y[f,g],h},{i,y[j,k],l}} *)

Answer 4

This is close to OPs code, and works for any row length:

With[{n=Floor[Length[First[list]]/2]},
  Map[Join[#[[;;n-1]],{y[#[[n]],#[[n+1]]]},#[[n+2;;]]]&,list]
]