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

Answer 3

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

Answer 4

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 5

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

Answer 6

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

MapThread[Insert[#1, #2, 2] &, p]

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

Answer 7

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