# Deleting elements from the nested list

I have a nested list:

 {{{1, 1, 1, 1}, {28.9063, 0.861155}}, {{1, 1, 1, 11}, {32.2188, 0.512393}}, {{1, 1, 1, 21}, {29.9063, 0.410614}}, {{1, 1, 1, 31}, {27.4219, 0.351969}}}


and I would like to delete these elements 28.9063, 32.2188, 29.9063, 27.4219. Final list should look like this:

{{{1, 1, 1, 1},  0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}}


Is there in Mathematica quick way to do it without a lot of cycles?

You can use Replace to replace the two-element lists on level 2 with their second entry:

list = {{{1, 1, 1, 1}, {28.9063, 0.861155}}, {{1, 1, 1, 11}, {32.2188, 0.512393}}, {{1, 1, 1, 21}, {29.9063, 0.410614}}, {{1, 1, 1, 31}, {27.4219, 0.351969}}};
Replace[list, {_, x_} :> x, {2}]
(* {{{1, 1, 1, 1},  0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}} *)


Alternatively, you can use assignments to Parts of the expression:

res = list;
res[[All, 2]] = res[[All, 2, 2]];
res
(* {{{1, 1, 1, 1}, 0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}} *)


Note that we copy the list first to avoid modifying the original. Based on quick tests, this is ~20x faster on my machine than the first solution

alist = {{{1, 1, 1, 1}, {28.9063, 0.861155}}, {{1, 1, 1,
11}, {32.2188, 0.512393}}, {{1, 1, 1, 21}, {29.9063,
0.410614}}, {{1, 1, 1, 31}, {27.4219, 0.351969}}}


Using replacement and without overwriting the original list:

alist /. {a_Real, b_Real} :> b


EDIT

Using SequenceReplace:

SequenceReplace[alist,
{{a_List, {b_Real, c_Real}}} :> {a, c}
]


The Sequence* functions are not known for their performance but these are quite flexible.

Result:

{{{1, 1, 1, 1}, 0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}}

• (+1) Using SequenceReplace. Commented Oct 5, 2022 at 17:39
• (+1) To make a general pedantic point (which does not directly apply here), ReplaceAll " looks at each part of expr, tries all the rules on it, and then goes on to the next part of expr" and "The first rule that applies to a particular part is used; no further rules are tried on that part or on any of its subparts". ReplaceAll tries all parts of expr from the outside in, including the Head, (including in the OP example) and this can cause problems if the pattern happens to match 'Head'. Commented Dec 24, 2022 at 22:04
• Since this post by szabolcs I have personally stopped using ReplaceAll in favour of Replace as I have been badly 'bitten' in the past. See also this answer by Lucas Lang Commented Dec 24, 2022 at 22:07

Using Cases:

Cases[list, {{x__},{y_,z_}}:> {{x},z}]

(*  {{{1, 1, 1, 1}, 0.861155}, {{1, 1, 1, 11}, 0.512393},
{{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}} *)


Alternatively:

Cases[list, {x_List,{y_,z_}}:> {x,z}]


Just another way, using Cases, DeleteElements and Function:

Map[Function[{y}, Join[DeleteElements[y, {_, x_} :> x], Cases[y, {_, x_} :> x]]], list]
(*{{{1, 1, 1, 1}, 0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}}*)


Or using MapAt:

Transpose@MapAt[#[[All, 2]] &, Transpose@list, {2}]
(*{{{1, 1, 1, 1}, 0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}}*)


Thanks to @eldo for the following shorter version using MapAt:

MapAt[Last, {All, 2}]@list

(*same result*)

• Shorter: MapAt[Last, {All, 2}]@list
– eldo
Commented Apr 7 at 0:41
• Cheers, @eldo! I will update my answer ;) Commented Apr 7 at 0:53

Another approach, though slower, makes use of the new function DeleteElements from v13.1

It is handy if you

1. Want to preserve the dimensions of the original list (list)
2. Delete specific elements which may or may not repeat
3. Elements to delete are not in order
list={{{1,1,1,1},{28.9063,0.861155}},{{1,1,1,11},{32.2188,0.512393}},{{1,1,1,21},{29.9063,0.410614}},{{1,1,1,31},{27.4219,0.351969}}};

finalList={{{1,1,1,1},0.861155},{{1,1,1,11},0.512393},{{1,1,1,21},0.410614},{{1,1,1,31},0.351969}};

delete={28.9063,32.2188,29.9063,27.4219}; (* or list[[All,2,1]] *)

deletedList=Map[DeleteElements[#,delete]&,list,2]; (* {{{1,1,1,1},{0.861155}},{{1,1,1,11},{0.512393}},{{1,1,1,21},{0.410614}},{{1,1,1,31},{0.351969}}} *)
deletedList === finalList (* False*)


gar = Transpose@deletedList;
bar = Flatten[#[[-1]]] &@gar;


list =
{{{1, 1, 1, 1}, {28.9063, 0.861155}},
{{1, 1, 1, 11}, {32.2188, 0.512393}},
{{1, 1, 1, 21}, {29.9063, 0.410614}},
{{1, 1, 1, 31}, {27.4219, 0.351969}}};


Using ReplaceAt (new in 13.1)

ReplaceAt[{_, a_} :> a, {All, 2}] @ list


{{{1, 1, 1, 1}, 0.861155}, {{1, 1, 1, 11}, 0.512393}, {{1, 1, 1, 21}, 0.410614}, {{1, 1, 1, 31}, 0.351969}}