7
$\begingroup$

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.

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

7 Answers 7

4
$\begingroup$

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}} *)
$\endgroup$
6
$\begingroup$

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

$\endgroup$
1
  • 1
    $\begingroup$ 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}. $\endgroup$
    – user293787
    Aug 18, 2022 at 5:59
4
$\begingroup$

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]
]
$\endgroup$
4
$\begingroup$

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}} *)
$\endgroup$
3
$\begingroup$

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

$\endgroup$
2
$\begingroup$
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}}

$\endgroup$
2
$\begingroup$
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}
   } *) 
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.