# Group list elements using second list [duplicate]

I would like to group list

{"a", "b", "c", "d", "e", "f", "g"}


using second list with group numbers

{1,2,1,2,3,3,1}


in the following way that it gives me new list

{{"a","c","g"},{"b","d"},{"e","f"}}


I'd like also that it works in Manipulate, so I could split my list in groups dynamically

fls = {"p1.DAT", "p2.DAT", "p3.DAT", "p4.DAT", "p5.DAT", "p6.DAT", "p7.DAT", "p8.DAT"};
vars = Table[Symbol["$x" <> ToString@i], {i, fls // Length}]; n = 4; Manipulate[Evaluate@{vars, fls}, Evaluate[Sequence @@ Table[{{vars[[i]], 1, fls[[i]]}, Range[n]}, {i, 1, vars // Length}]]]  ## 7 Answers lst1 = {"a", "b", "c", "d", "e", "f", "g"}; lst2 = {1, 2, 1, 2, 3, 3, 1}; Values@GroupBy[Thread[{lst1, lst2}], Last -> First] (* {{"a", "c", "g"}, {"b", "d"}, {"e", "f"}} *)  • Use Values, instead of Last /@ Normal@, to extract the values from the Association. Commented Nov 1, 2016 at 17:37 • And if lst2 is a list of variables which I set in Manipulate? fls = {"p1.DAT", "p2.DAT", "p3.DAT", "p4.DAT", "p5.DAT", "p6.DAT", "p7.DAT", "p8.DAT"}; vars = Table[Symbol["$x" <> ToString@i], {i, fls // Length}]; n = 4; Manipulate[Evaluate@vars, Evaluate[Sequence @@ Table[{{vars[[i]], 1, fls[[i]]}, Range[n]}, {i, 1, vars // Length}]]] Commented Nov 1, 2016 at 17:42
• @ФилиппЦветков. Phillip, that strikes me as a different question than the one you asked. It's best to search this site for how to extract data from a Manipulate object or ask a new question. Commented Nov 1, 2016 at 18:02
• Ok I'll do it.. Commented Nov 1, 2016 at 18:03
• @rcollyer. OF COURSE. Silly. Commented Nov 1, 2016 at 18:51
list1 = {"a", "b", "c", "d", "e", "f", "g"};
list2 = {1, 2, 1, 2, 3, 3, 1};

InternalPartitionRagged[list1[[Ordering @ list2]], Length /@ Gather @ list2]


{{"a", "c", "g"}, {"b", "d"}, {"e", "f"}}

Or

Map[First, #, {2}]& @ GatherBy[#, Last]& @ Transpose @ {list1, list2}


A timing comparison for all suggested methods which do not sort (Mathematica 11.0.0):

f1[{list_, labels_}] := Extract[list, Position[labels, #]] & /@ DeleteDuplicates@labels

f2[{list_, labels_}] := Pick[list, labels, #] & /@ DeleteDuplicates@labels

f3[{list_, labels_}] := Reap[MapThread[Sow, {list, labels}]][[2]]

f4[{list_, labels_}] := list[[#]] & /@ GatherBy[Range@Length@labels, labels[[#]] &]

f5[{list_, labels_}] := Values@GroupBy[Thread[{list, labels}], Last -> First]

f6[{list_, labels_}] := GatherBy[Transpose@{list, labels}, Last][[All, All, 1]]

f7[{list_, labels_}] := ReplaceList[#, Thread[labels -> list]] & /@ DeleteDuplicates@labels

f8[{list_, labels_}] := Map[First, #, {2}] &@GatherBy[#, Last] &@Transpose@{list, labels}

f9[{list_, labels_}] := Extract[list, List /@ GatherBy[Range@Length@list, labels[[#]] &]]

f10[{list_, labels_}] := Values@Merge[Association /@ Thread[Rule[labels, list]], Identity]

Needs["GeneralUtilities"]
g[n_] := {RandomChoice[CharacterRange["a", "z"], n], RandomInteger[{1, n}, n]}
benchmarks = Benchmark[#, g, 10] & /@ {f1, f2, f3, f4, f5, f6, f7, f8, f9, f10};


For better readability I use a set of plot markers which tolerate overlapping from my PolygonPlotMarkers package:

Needs["PolygonPlotMarkers"]

ListLogLogPlot[benchmarks, ImageSize -> 600, BaseStyle -> FontSize -> 16, PlotMarkers -> {
Graphics[{FaceForm[Blue], EdgeForm[None], PolygonMarker["Circle", Offset[7]]}],
Graphics[{FaceForm[RGBColor[0.7, 0.745, 0.82]], EdgeForm[], PolygonMarker["Square", Offset[8]]}],
Graphics[{FaceForm[Green], EdgeForm[None], PolygonMarker["TripleCross", Offset[7]]}],
Graphics[{FaceForm[Red], EdgeForm[], PolygonMarker["FourPointedStar", Offset[9]]}],
Graphics[{FaceForm[Darker@Yellow], EdgeForm[None], PolygonMarker["DiagonalCross", Offset[7]]}],
Graphics[{FaceForm[], EdgeForm[{Brown, Opacity[1], AbsoluteThickness[2]}], PolygonMarker["DiagonalSquare", Offset[7]]}],
Graphics[{FaceForm[Cyan], EdgeForm[None], PolygonMarker["Square", Offset[7]]}],
Graphics[{FaceForm[Blue], EdgeForm[None], PolygonMarker["Cross", Offset[7]]}],
Graphics[{FaceForm[], EdgeForm[{Opacity[1], Black}], PolygonMarker["ThreePointedStar", Offset[7]]}],
Graphics[{FaceForm[], EdgeForm[{Opacity[1], Black}], PolygonMarker["Square", Offset[8]]}]},
PlotLegends -> PointLegend[{f1, f2, f3, f4, f5, f6, f7, f8, f9, f10}, LegendMarkerSize -> 15]]


A few more alternatives:

Extract[list1, List /@ GatherBy[Range@Length@list1, list2[[#]] &]]
list1[[#]] & /@ GatherBy[Range@Length@list1, list2[[#]] &]
Pick[list1, list2, #] & /@ DeleteDuplicates[list2]


all give

{{"a", "c", "g"}, {"b", "d"}, {"e", "f"}}

Here's another (kind of weird) option:

lst1 = {"a", "b", "c", "d", "e", "f", "g"};
lst2 = {1, 2, 1, 2, 3, 3, 1};

DeleteDuplicates[lst2]/. Merge[Association /@ Thread[Rule[lst2, lst1]], Identity]


Edit: As rcollyer points out:

Values@Merge[Association /@ Thread[Rule[lst2, lst1]], Identity]


Shortens the code a bit. Thanks for the heads up!

• This can be simplified, conceptually, by using Values on the Association, instead of feeding it through DeleteDuplicates via ReplaceAll. Commented Nov 1, 2016 at 17:38
ReplaceList[#, Thread[lst2 -> lst1]] & /@ {1, 2, 3}


{{a, c, g}, {b, d}, {e, f}}

GatherBy[Transpose@{list1, list2}, Last][[All, All, 1]]

{{"a", "c", "g"}, {"b", "d"}, {"e", "f"}}
`