8

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}]]]
Филипп Цветков
  • 3,461
  • 1
  • 15
  • 34

7 Answers7

8
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"}} *)
march
  • 23,399
  • 2
  • 44
  • 100
  • 1
    Use Values, instead of Last /@ Normal@, to extract the values from the Association. – rcollyer Nov 01 '16 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}]]] – Филипп Цветков Nov 01 '16 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. – march Nov 01 '16 at 18:02
  • Ok I'll do it.. – Филипп Цветков Nov 01 '16 at 18:03
  • @rcollyer. OF COURSE. Silly. – march Nov 01 '16 at 18:51
5
list1 = {"a", "b", "c", "d", "e", "f", "g"};
list2 = {1, 2, 1, 2, 3, 3, 1};

Internal`PartitionRagged[list1[[Ordering @ list2]], Length /@ Gather @ list2]

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

Or

Map[First, #, {2}]& @ GatherBy[#, Last]& @ Transpose @ {list1, list2}
corey979
  • 23,947
  • 7
  • 58
  • 101
5

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

plot

Community
  • 1
Alexey Popkov
  • 61,809
  • 7
  • 149
  • 368
4

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

kglr
  • 394,356
  • 18
  • 477
  • 896
3

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!

N.J.Evans
  • 5,093
  • 19
  • 25
  • 1
    This can be simplified, conceptually, by using Values on the Association, instead of feeding it through DeleteDuplicates via ReplaceAll. – rcollyer Nov 01 '16 at 17:38
3
ReplaceList[#, Thread[lst2 -> lst1]] & /@ {1, 2, 3}

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

user1066
  • 17,923
  • 3
  • 31
  • 49
3
GatherBy[Transpose@{list1, list2}, Last][[All, All, 1]]

{{"a", "c", "g"}, {"b", "d"}, {"e", "f"}}
Fortsaint
  • 2,060
  • 15
  • 17