# Mapping function to sublist

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.

• "However, the actual lists are long" Do you mean it's actually a m×2n list? Aug 18, 2022 at 3:43
• yes, but in the actual lists I'm not necessarily applying the function to exactly the middle elements Aug 18, 2022 at 4:12

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


Using MapThread and TakeList:

Clear["Global*"];
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}}; (* Thanks @I.M *)

f[x_List] :=
MapThread[#1 @@ #2 &, {{Sequence, f, Sequence},
TakeList[x, {1, 2, All}]}]

f /@ list1


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

f /@ list2


{{a, f[b, c], d1, d2}, {e, f[f, g], h1, h2}, {i, f[j, k], l1, l2}}

Previously

Using pattern matching:

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


Edit (applying pattern at level 1 only)

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

• There is potentially a problem if the list has length 4, as in ConstantArray[0,{4,4}]/. {a_,b_,c_,d_}->{a,y[b,c],d}. Aug 18, 2022 at 5:59

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]
]


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


Using Takelist and ReplaceAt (new in 13.1)

submap[list_, f_, p_] :=
With[{q = {p[[1]] - 1, First @ Differences[p] + 1, All}},
Flatten /@ ReplaceAt[x_ :> (f @@ x), {All, 2}][TakeList[#, q] & /@ list]]

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

submap[la, y, {2, 3}]


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

submap[la, Plus, {1, 3}]


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

lb = {{a, b, c, d1, d2}, {e, f, g, h1, h2}, {i, j, k, l1, l2}};

submap[lb, y, {3, 4}]


{{a, b, y[c, d1], d2}, {e, f, y[g, h1], h2}, {i, j, y[k, l1], l2}}

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


Using MapThread and Insert:

p = {#[[All, {1, -1}]] &@lst, y @@@ #[[All, 2 ;; -2]] &@lst};



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

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

MapThread[{#1, y[#2, #3], #4} &, Transpose@list]

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


list2 = {
{a, b, c, d, d2, d3, d4},
{e, f, g, h, h2, h3, h4},
{i, j, k,l, l2, l3, l4}
}

MapThread[{#1, y[#2, #3], ##4} &, Transpose@list2]

(* {
{a, y[b, c], d, d2, d3, d4},
{e, y[f, g], h, h2, h3, h4},
{i, y[j, k], l, l2, l3, l4}
} *)


list3 = {
{a, a2, b, c, d, d2, d3, d4},
{e, e2, f, g, h, h2, h3, h4},
{i, i2, j, k, l, l2, l3, l4}
}

MapThread[{Splice[{##1}[[;; 2]]], y[#3, #4], ##5} &, Transpose@list3]

(* {
{a, a2, y[b, c], d, d2, d3, d4},
{e, e2, y[f, g], h, h2, h3, h4},
{i, i2, y[j, k], l, l2, l3, l4}
} *)
`