12
$\begingroup$

Problem statement

The following challenge was recently posted to the J language programming forum by Skip Cave (http://jsoftware.com/pipermail/programming/2016-March/044561.html):

"The animal control officer wants to keep track of the animals in a city. The officer tags all the animals with a serial number. He keeps a list of all the animals he has tagged, along with each serial number."

In Mathematica form, the given list is:

    data = {{"bird", 1}, {"cow", 2}, {"cow", 3}, {"dog", 4}, {"cow", 5},   
            {"cow", 6}, {"cow", 7}, {"bird", 8}, {"dog", 9}, {"cat", 10},   
            {"dog", 11}, {"pig", 12}, {"dog", 13}, {"bird", 14}, {"pig", 15}};

"The officer now wants to make a second list showing each type of animal along with all the serial numbers tagged for each animal."

In Mathematica form, the desired output is:

    {{"bird", {1, 8, 14}}, {"cow", {2, 3, 5, 6, 7}}, 
     {"dog", {4, 9, 11, 13}}, {"cat", {10}}, {"pig", {12, 15}}}

The challenge is to transform the given input data into that output form in as simple a way as possible. (As phrased in the J Programming forum post, the challenge was to do so in as short an expression as possible.)

My solution so far:

    creatures = Union[First /@ data]
    gathered = GatherBy[data, First]
    serials = Map[Last, #] & /@ gathered
    Transpose[{creatures, serials}]

Naturally, multiple steps may be combined, e.g.:

    serials = Map[Last, #] & /@ GatherBy[data, First]

In fact, all steps could be combined into one long expression:

    Transpose[{Union[First /@ data], Map[Last, #] & /@ GatherBy[data, First]}]

Moreover, the list serials of lists of serial numbers could be formed using patterned replacement:

    serials = gathered /. {animal_, n_Integer} -> n

Question

Is there some significantly shorter or simpler way to do this?

Notes

  1. The original data and desired output could have been cast into the form of associations, but I suspect the operations required to go from data to output would be essentially the same.

  2. Probably the output should be fed into SortBy[#, First]& so as to rearrange the output list to be sorted alphabetically by animal name.

P.S.

Can you suggest a better, but succinct, title for my post?

$\endgroup$
4
  • 5
    $\begingroup$ Why not Normal[GroupBy[data, First -> Last]] /. Rule -> List? $\endgroup$ Commented Mar 4, 2016 at 18:04
  • 1
    $\begingroup$ @J. M.: OMG! Please post as answer. $\endgroup$ Commented Mar 4, 2016 at 18:12
  • $\begingroup$ @J. M.: I wonder if there's still some way, though, to avoid using Association as an intermediate structure. $\endgroup$ Commented Mar 4, 2016 at 18:19
  • 1
    $\begingroup$ @murray I don't know if it matters to you, but if you are after the shortest possible version, then the following slight modification of J.M.'s code will also work: List@@@Normal@GroupBy[data, First -> Last] $\endgroup$ Commented Mar 4, 2016 at 18:53

4 Answers 4

2
$\begingroup$

Using Merge:

data = {{"bird", 1}, {"cow", 2}, {"cow", 3}, {"dog", 4}, {"cow", 
    5}, {"cow", 6}, {"cow", 7}, {"bird", 8}, {"dog", 9}, {"cat", 
    10}, {"dog", 11}, {"pig", 12}, {"dog", 13}, {"bird", 14}, {"pig", 
    15}};

Normal[Merge[Rule @@@ data, Identity]] /. Rule -> List

{{"bird", {1, 8, 14}}, {"cow", {2, 3, 5, 6, 7}}, {"dog", {4, 9, 11,
13}}, {"cat", {10}}, {"pig", {12, 15}}}

$\endgroup$
2
  • $\begingroup$ Nice and short and clear! $\endgroup$ Commented May 11, 2023 at 14:50
  • $\begingroup$ Thanks @murray. $\endgroup$ Commented May 11, 2023 at 14:58
17
$\begingroup$

As requested by the OP:

Normal[GroupBy[data, First -> Last]] /. Rule -> List
   {{"bird", {1, 8, 14}}, {"cow", {2, 3, 5, 6, 7}}, {"dog", {4, 9, 11, 13}},
    {"cat", {10}}, {"pig", {12, 15}}}

The handy bit here is the second argument of GroupBy[]:

GroupBy[data, First -> Last]
   <|"bird" -> {1, 8, 14}, "cow" -> {2, 3, 5, 6, 7}, "dog" -> {4, 9, 11, 13},
     "cat" -> {10}, "pig" -> {12, 15}|>

which transforms the values associated with the keys into the desired list of numbers. Contrast this with a plain GroupBy[data, First].

As noted by multiple people, a more compact version is

List @@@ Normal[GroupBy[data, First -> Last]]

Tom in a comment below gives a slicker version:

KeyValueMap[List, GroupBy[data, First -> Last]]

The GatherBy[] approach presented by the OP can also be written as

Append[Union[#[[All, 1]]], #[[All, 2]]] & /@ GatherBy[data, First]

or as

Append @@ MapAt[Union, Transpose[#], 1] & /@ GatherBy[data, First]
$\endgroup$
4
  • $\begingroup$ OP edited so as to show correct "desired output". $\endgroup$ Commented Mar 4, 2016 at 20:32
  • $\begingroup$ The variant, List @@@ Normal[GroupBy[data, First -> Last]] is slightly shorter. $\endgroup$ Commented Mar 5, 2016 at 3:11
  • $\begingroup$ Just for fun: Transpose@{Keys@#, Values@#} & @ GroupBy[data, First -> Last] $\endgroup$ Commented Mar 5, 2016 at 12:54
  • 1
    $\begingroup$ Even more fun: KeyValueMap[List, GroupBy[data, First -> Last]] $\endgroup$ Commented Mar 5, 2016 at 13:12
11
$\begingroup$

I think this is one of the simplest here, both conceptually and in code:

Reap[Sow @@@ Reverse[data, {2}], _, List][[2]]
$\endgroup$
8
  • $\begingroup$ in code, that is for sure, but conceptually it requires some comments :)) +1 as always... $\endgroup$ Commented Mar 4, 2016 at 20:27
  • 2
    $\begingroup$ @garej Conceptually, I consider tagging carried out by Reap - Sow the simplest and most direct idiom here. Using an assoc requires then to transform it later to lists (2 extra operations - Normal and replacement of a rule with a list - and either of these can go subtly wrong for more complex keys / values), which to me feels less natural. $\endgroup$ Commented Mar 4, 2016 at 20:51
  • 2
    $\begingroup$ @murray It's actually pretty simple. Sow[expr, tag] marks expression with the tag tag. In this case, I had to reverse inner lists, since I wanted to tag integer indices by animal names, so I needed an index to be the first and animal name to be the last in each inner list. Then Reap[code, _, f] collects together all parts that were tagged with a given tag in code, and applies f[tag, collected-items], for each tag, and returns these in a List. Having it as List would just produce {animal-name, {indices}}, since we used animal names as tags. $\endgroup$ Commented Mar 4, 2016 at 22:34
  • 1
    $\begingroup$ @murray, if you feel that Leonid's answer is more suitable to your needs, feel free to shift the acceptance. $\endgroup$ Commented Mar 5, 2016 at 1:43
  • 2
    $\begingroup$ The most educational approach here for me +1 $\endgroup$ Commented Mar 5, 2016 at 15:52
5
$\begingroup$
MapAt[#[[1]]&, Transpose/@ GatherBy[data, First], {;; , 1}]

{{"bird", {1, 8, 14}}, {"cow", {2, 3, 5, 6, 7}}, {"dog", {4, 9, 11, 13}}, {"cat", {10}}, {"pig", {12, 15}}}

Edit Corrected by murray, aka OP:

MapAt[Last, Transpose/@ GatherBy[data, First], {;; , 1}]

Edit2 Just for the ad hoc case with specific numeration PositionIndex:

List @@@ Normal @ PositionIndex[data[[All, 1]]]
$\endgroup$
3
  • 1
    $\begingroup$ This answer becomes a bit simpler if you replace #[[1]]& by First. $\endgroup$ Commented Mar 4, 2016 at 20:51
  • $\begingroup$ @murray, you are rigth. Why you didn't like the Reap-Sow solution? $\endgroup$ Commented Mar 4, 2016 at 21:09
  • 1
    $\begingroup$ It's not that I don't like the Reap-Sow solution, it's that I do not yet understand it. The indexing [[2]] there is the trivial part that I do understand. My difficulty is I have not yet found a satisfactorily complete explanation about "tagging" that allows Reap to return not just the final result, which that indexing throws away, but more importantly the rest of the final output. $\endgroup$ Commented Mar 4, 2016 at 21:26

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.