9
$\begingroup$

Consider a list like the following one

list = { { a1 , {b1,c1} } , { a2 , {b2,c2} } , { a3 , {b3,c3} } };

I would like to select a sub-sequence from this list such that the output reads

{ { a1 , c1 } , { a2 , c2 } , { a3 , c3 } }

To get this, I have tried the following:

list[[ ;; , {1,{2}} ]]

but Mathematica complains that this is not valid input. How should I make the selection properly?

EDIT:

It is great to see so many different solutions being suggested! I would just like to point out that the ideal solution should be accessing the list "in place" as in:

list2 = { {d1,e1} , {d2,e2} , {d3,e3} };
list[[ ;; , {1,{2}} ]] = list2;
list

{ { d1 , {b1,e1} } , { d2 , {b2,e2} } , { d3 , {b3,e3} } }

where I used my wrong syntax from above that does not actually work to demonstrate the point.

EDIT2:

Of course there is nothing particularly special or important about the specific dimensions and arrangement of the elements in list. A solution that would be useful in general should allow to specify the parts one needs from all sorts of list structures.

$\endgroup$
5
  • 7
    $\begingroup$ {#, #2[[-1]]} & @@@ list or {#[[1]], #[[2, -1]]} & /@ list? $\endgroup$
    – kglr
    Commented Jun 23, 2018 at 3:54
  • 1
    $\begingroup$ @kglr I see, yes, such maps should work, thank you. For some reason I was expecting mathematica to also be able to access the fields in place without writing a new list, but I'm probably wrong. $\endgroup$
    – Kagaratsch
    Commented Jun 23, 2018 at 4:06
  • 4
    $\begingroup$ I don't know you like it but here is another way to get your output. Partition[Flatten@list, 3][[;; , {1, 3}]] $\endgroup$ Commented Jun 23, 2018 at 6:47
  • 1
    $\begingroup$ I have provided benchmarks for all the solutions provided so far, with @AlexeyPopkov been the fastest for long lists. $\endgroup$
    – rhermans
    Commented Jun 23, 2018 at 8:43
  • 3
    $\begingroup$ All 10 solutions so far seems very hacky to me, and it's somehow disappointing that Part doesn't allow what the OP expected with list[[All, {1,{2}} ]], probably with a different syntax.. $\endgroup$
    – rhermans
    Commented Jun 23, 2018 at 9:04

8 Answers 8

3
$\begingroup$

Task

Basically you want a Part function which accepts positional arguments. Let us extend the example a little further to get more levels:

list = {
   {a1, {b1, c1}, d1, {e1, {f1, g1}}},
   {a2, {b2, c2}, d2, {e2, {f2, g2}}},
   {a3, {b3, c3}, d3, {e3, {f3, g3}}}
 };

Suppose we want all a, c and gs, the partspec would be:

list[[All, {1, {2}, {}, {{}, {2}}}]];

partspec = {1, {2}, {}, {{}, {2}}};

Core Solution

We define a function which will resolve positional part arguments. First we retrieve the positions for all atomic values:

positions = Position[partspec, _?AtomQ, Heads -> False]

{{1}, {2, 1}, {4, 2, 1}}

All but the last indices give us the position we need to extract later. The last index, however, has to be replaced with the actual number that was given in partspec:

parts = MapThread[
 Join[Most@#1, {#2}] &,
 {positions, Extract[partspec, positions]}
]

{{1}, {2, 2}, {4, 2, 2}}

The resolved partspec works with Extract:

Extract[#, parts] & /@ list

{{a1, c1, g1}, {a2, c2, g2}, {a3, c3, g3}}

The final function is:

ResolvePositionalPartspec[partspec_] := 
 With[{positions = Position[partspec, _?AtomQ, Heads -> False]},
  MapThread[
   Join[Most@#1, {#2}] &,
   {positions, Extract[partspec, positions]}]
  ]

Extended Solution

To be able to combine it with other partspecs such as Ranges or All, let's define another function which applies the ResolvePositionalPartspec function only to list arguments in Parts:

PositionalPart[list_, partspec___] := Fold[
  #2[#1] &,
  list,
  Replace[{partspec},
   {listspec_List :> (Map[Extract[#, ResolvePositionalPartspec@listspec] &, #] &),
    otherspec_ :> (Part[#, otherspec] &)},
   {1}]
  ]

The idea is to replace each argument in the partspec with a pure function and subsequently apply it via Fold. Note that this does not exactly reproduce the behaviour of Part on subsequent levels, but I found it to be quite practical anyhow.

Now we can use it with our list:

PositionalPart[list, All, partspec]

{{a1, c1, g1}, {a2, c2, g2}, {a3, c3, g3}}

PositionalPart[list, 1 ;; 2, partspec]

{{a1, c1, g1}, {a2, c2, g2}}

It will fail when the first partspec does not give a list (since Mapping on level 1 is hard-coded in PositionalPart):

PositionalPart[list, 1, partspec]

Extract::partd: Part specification {1} is longer than depth of object. >>

Use PositionalPart[list, 1;;1, partspec] instead. Note that PositionalPart[list, {1}, partspec] will not work because {1} will be interpreted as a positional part argument, as in:

PositionalPart[list, {1}]

{{a1}, {a2}, {a3}}

Application

To use it an everyday coding, you can redefine Part to work the way PositionalPart does. When replacing Part, I would add something symbolic to the definition, similar to the UpTo[] function, like:

Part[list, All, Positional[{1, {2}, {}, {{}, {2}}}]]

This means you will not loose the regular {} syntax.

To achieve this, the Replace statement in PositionalPart would be modified to replace only specifications wrapped in Positional[] with the Extract[ResolvePositionalPartspec] function instead of replacing all lists.

$\endgroup$
2
  • $\begingroup$ I like this solution a lot due to its generality! I wonder if it uses the most efficient script to achieve the construction? Will wait a little bit, and if nothing else shows up, will accept this answer. $\endgroup$
    – Kagaratsch
    Commented Jun 23, 2018 at 13:06
  • $\begingroup$ Glad you like it. I expect the PositionalPart function to be slower than regular Parts because it extracts each level in the partspec separately. To become a production-grade function this one has to be optimized a little more anyway (including some error checking and such). The core function, ResolvePositionalPartspec, seems fine and efficient to me, however. $\endgroup$
    – Theo Tiger
    Commented Jun 25, 2018 at 12:20
8
$\begingroup$

I was expecting mathematica to also be able to access the fields in place without writing a new list

In-place modification approach:

list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};
list[[;; , 2]] = list[[;; , 2, 2]];
list
{{a1, c1}, {a2, c2}, {a3, c3}}
$\endgroup$
1
  • 2
    $\begingroup$ This is the fastest solution so far, but beware that you are redefining list and therefore loosing information. In the benchmarks I implemented your solution inside Module[{modlist = list},...] which is almost as fast without modifying the original list. $\endgroup$
    – rhermans
    Commented Jun 23, 2018 at 9:14
8
$\begingroup$

Other solutions

MapAt[Last, list, {All, 2}]
(* {{a1, c1}, {a2, c2}, {a3, c3}} *)

list /. {x_, {y_, z_}} -> {x, z}
(* {{a1, c1}, {a2, c2}, {a3, c3}} *)

Benchmark

Large data, 10^7 lines.

largeList = 
  Table[{RandomReal[1], {RandomReal[1], RandomReal[1]}}, {10^7}];

First@AbsoluteTiming returns the absolute number of seconds in real time that have elapsed during evaluation.

First@AbsoluteTiming[
  MapAt[Last, largeList, {All, 2}]
  ]
(* 4.86435 *)

First@AbsoluteTiming[
  largeList /. {x_, {y_, z_}} -> {x, z}
  ]
(* 4.95776 *)

First@AbsoluteTiming[
  Partition[Flatten@largeList, 3][[All, {1, 3}]]
  ]
(* 3.66688 *)

First@AbsoluteTiming[
  {#, #2[[-1]]} & @@@ largeList
  ]
(* 8.83799 *)

First@AbsoluteTiming[
  {#[[1]], #[[2, -1]]} & /@ largeList
  ]
(* 12.3966 *)

First@AbsoluteTiming[
  Module[{modlist = largeList}
   , modlist[[;; , 2]] = modlist[[;; , 2, 2]]
   ]
  ]
(* 2.6865 *)

First@AbsoluteTiming[
  Query[All, {1 -> Identity, 2 -> Last}]@largeList
  ]
(* 23.1379 *)

First@AbsoluteTiming[
  {#, #2 & @@ #2} & @@@ largeList
  ]
(* 12.7286 *)

First@AbsoluteTiming[
  {#[[1]], #[[2, 2]]} & /@ largeList
  ]
(* 13.2996 *)

First@AbsoluteTiming[
  largeList[[;; , 2]] = largeList[[;; , 2, 2]]
  ]
(* 2.07737 *)
$\endgroup$
8
$\begingroup$

Update: Using a slightly modified version of the list of parts:

list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};
parts = {{1}, {2, 2}};
list2 = {{d1, e1}, {d2, e2}, {d3, e3}};
Do[(list[[i, ##]] = list2[[i, #]]) & @@@ parts, {i, Length @ list2}]
list

{{d1, {b1, e1}}, {d2, {b2, e2}}, {d3, {b3, e3}}}

Alternatively, you can use ReplacePart:

list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};
list = ReplacePart[list, ({i_, ##} :> list2[[i, #]]) & @@@ parts];
list

{{d1, {b1, e1}}, {d2, {b2, e2}}, {d3, {b3, e3}}}

Original answer:

Few additional alternatives:

Transpose@{list[[All, 1]], list[[All, 2, 2]]}
Cases[list , {a_, {b_, c_}} :> {a, c}]
Replace[list , {_, b_} :> b, {2}]
Query[All, {1 -> Identity, 2 -> Last}] @ list
{#, #2 & @@ #2} & @@@ list
{#, #2[[-1]]} & @@@ list
{#[[1]], #[[2, 2]]} & /@ list 

all give

{{a1, c1}, {a2, c2}, {a3, c3}}

$\endgroup$
4
$\begingroup$
list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};

Using Comap (new in 14.0)

Comap[{First, Last @* Last}] /@ list

{{a1, c1}, {a2, c2}, {a3, c3}}

$\endgroup$
3
$\begingroup$

For the wanted in-place solution there is also ApplyTo (since V 12.2):

list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};

list //= MapAt[Last, {All, 2}];

list

{{a1, c1}, {a2, c2}, {a3, c3}}

$\endgroup$
3
$\begingroup$
list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};

Using Thread:

Last /@ Thread /@ list

(*{{a1, c1}, {a2, c2}, {a3, c3}}*)
$\endgroup$
2
$\begingroup$
Clear["Global`*"]
list = {{a1, {b1, c1}}, {a2, {b2, c2}}, {a3, {b3, c3}}};

SubsetMap[Map[Last], list, {All, 2}]

{{a1, c1}, {a2, c2}, {a3, c3}}

$\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.