Select the top N values by group

Question

This is in response to a question asked on the r-help mailing list.

Here are lots of examples of how to find top values by group using sql, so I imagine it's easy to convert that knowledge over using the R sqldf package.

An example: when mtcars is grouped by cyl, here are the top three records for each distinct value of cyl. Note that ties are excluded in this case, but it'd be nice to show some different ways to treat ties.

                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb ranks
Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1   2.0
Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2   1.0
Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1   2.0
Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4   3.0
Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4   1.0
Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4   1.5
Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4   1.5
Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4   3.0

How to find the top or bottom (maximum or minimum) N records per group?

December

In case one needs to select different k records per group, this question can help: https://mcmap.net/q/281732/-get-top-k-records-per-group-where-k-differs-by-group-in-r-data-table/1840471 – Nickey

Answer 1

# start with the mtcars data frame (included with your installation of R)
mtcars

# pick your 'group by' variable
gbv <- 'cyl'
# IMPORTANT NOTE: you can only include one group by variable here
# ..if you need more, the `order` function below will need
# one per inputted parameter: order( x$cyl , x$am )

# choose whether you want to find the minimum or maximum
find.maximum <- FALSE

# create a simple data frame with only two columns
x <- mtcars

# order it based on 
x <- x[ order( x[ , gbv ] , decreasing = find.maximum ) , ]

# figure out the ranks of each miles-per-gallon, within cyl columns
if ( find.maximum ){
    # note the negative sign (which changes the order of mpg)
    # *and* the `rev` function, which flips the order of the `tapply` result
    x$ranks <- unlist( rev( tapply( -x$mpg , x[ , gbv ] , rank ) ) )
} else {
    x$ranks <- unlist( tapply( x$mpg , x[ , gbv ] , rank ) )
}
# now just subset it based on the rank column
result <- x[ x$ranks <= 3 , ]

# look at your results
result

# done!

# but note only *two* values where cyl == 4 were kept,
# because there was a tie for third smallest, and the `rank` function gave both '3.5'
x[ x$ranks == 3.5 , ]

# ..if you instead wanted to keep all ties, you could change the
# tie-breaking behavior of the `rank` function.
# using the `min` *includes* all ties.  using `max` would *exclude* all ties
if ( find.maximum ){
    # note the negative sign (which changes the order of mpg)
    # *and* the `rev` function, which flips the order of the `tapply` result
    x$ranks <- unlist( rev( tapply( -x$mpg , x[ , gbv ] , rank , ties.method = 'min' ) ) )
} else {
    x$ranks <- unlist( tapply( x$mpg , x[ , gbv ] , rank , ties.method = 'min' ) )
}
# and there are even more options..
# see ?rank for more methods

# now just subset it based on the rank column
result <- x[ x$ranks <= 3 , ]

# look at your results
result
# and notice *both* cyl == 4 and ranks == 3 were included in your results
# because of the tie-breaking behavior chosen.

December

@Byway ..there's no other choice? :) ps thanx for your awesome answer – December

This is way complicated for such a simple task! – Okeechobee

@Byway I down voted because it seems way too complicated, as I complained about in my comment above. Maybe I'm just a bit cranky after spending hours shoveling my driveway... – Okeechobee

haha @Okeechobee a little unfair :P i wrote a lot of comments for newbies, but really, it's only three lines of code once you get rid of all the contingencies and notes.. – December

OK, points taken. Sorry for down voting. I don't think there is an undo button for that... – Okeechobee

Answer 2

This seems more straightforward using data.table as it performs the sort while setting the key.

So, if I were to get the top 3 records in sort (ascending order), then,

require(data.table)
d <- data.table(mtcars, key="cyl")
d[, head(.SD, 3), by=cyl]

does it.

And if you want the descending order

d[, tail(.SD, 3), by=cyl] # Thanks @MatthewDowle

Edit: To sort out ties using mpg column:

d <- data.table(mtcars, key="cyl")
d.out <- d[, .SD[mpg %in% head(sort(unique(mpg)), 3)], by=cyl]

#     cyl  mpg  disp  hp drat    wt  qsec vs am gear carb rank
#  1:   4 22.8 108.0  93 3.85 2.320 18.61  1  1    4    1   11
#  2:   4 22.8 140.8  95 3.92 3.150 22.90  1  0    4    2    1
#  3:   4 21.5 120.1  97 3.70 2.465 20.01  1  0    3    1    8
#  4:   4 21.4 121.0 109 4.11 2.780 18.60  1  1    4    2    6
#  5:   6 18.1 225.0 105 2.76 3.460 20.22  1  0    3    1    7
#  6:   6 19.2 167.6 123 3.92 3.440 18.30  1  0    4    4    1
#  7:   6 17.8 167.6 123 3.92 3.440 18.90  1  0    4    4    2
#  8:   8 14.3 360.0 245 3.21 3.570 15.84  0  0    3    4    7
#  9:   8 10.4 472.0 205 2.93 5.250 17.98  0  0    3    4   14
# 10:   8 10.4 460.0 215 3.00 5.424 17.82  0  0    3    4    5
# 11:   8 13.3 350.0 245 3.73 3.840 15.41  0  0    3    4    3

# and for last N elements, of course it is straightforward
d.out <- d[, .SD[mpg %in% tail(sort(unique(mpg)), 3)], by=cyl]

Byway

Hi. I'm not following what the head(seq(.I)) inside .SD[...] does. Why not head(.SD,3)? Or d[,.SD[head(order(mpg))],by=cyl]. d's key is one column (cyl), was it intended to include mpg in the key maybe? – Cairns

@MatthewDowle, :) the intention was your first suggestion head(.SD, 3). It dint occur to me to do the head straightforward! I'll edit it. – Byway

Ok great, +1. It's rare I find anything to comment about these days! – Cairns

@Byway I tried this, but it didn't work. I want to extract top 3 rows from my data table. But It extracted more and not sorted. Please see my problem – Sassoon

@Arun, this works as well if you want to sort on mpg: d <- data.table(mtcars, key=c("cyl","mpg")) d[, head(.SD, 3), by=cyl] – Jansenism

@Byway The answer is great but I feel that creating the table and setting the key makes the process less clear in terms of answering the question. – Magavern

Answer 3

dplyr does the trick

mtcars %>% 
arrange(desc(mpg)) %>% 
group_by(cyl) %>% slice(1:2)


 mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1  33.9     4  71.1    65  4.22 1.835 19.90     1     1     4     1
2  32.4     4  78.7    66  4.08 2.200 19.47     1     1     4     1
3  21.4     6 258.0   110  3.08 3.215 19.44     1     0     3     1
4  21.0     6 160.0   110  3.90 2.620 16.46     0     1     4     4
5  19.2     8 400.0   175  3.08 3.845 17.05     0     0     3     2
6  18.7     8 360.0   175  3.15 3.440 17.02     0     0     3     2

Hospitalize

If the user in interested in a result similar to SQL, then this dplyr result is the way to go – Lenin

hey Azam, are you still active here for a followup question? I'm using this answer for something – Jeseniajesh

Answer 4

Just sort by whatever (mpg for example, question is not clear on this)

mt <- mtcars[order(mtcars$mpg), ]

then use the by function to get the top n rows in each group

d <- by(mt, mt["cyl"], head, n=4)

If you want the result to be a data.frame:

Reduce(rbind, d)

Edit: Handling ties is more difficult, but if all ties are desired:

by(mt, mt["cyl"], function(x) x[rank(x$mpg) %in% sort(unique(rank(x$mpg)))[1:4], ])

Another approach is to break ties based on some other information, e.g.,

mt <- mtcars[order(mtcars$mpg, mtcars$hp), ]
by(mt, mt["cyl"], head, n=4)

Okeechobee

@Byway Um, what? There is a tie when cyl == 8 too... which the data.table solution seems to ignore. Using by we can retain both matches in both cases with by(mtcars, mtcars["cyl"], function(x) x[rank(x$mpg) < sort(unique(rank(x$mpg)))[4], ]) – Okeechobee

Couldn't you save steps with x[ x$mpg < sort( x$mpg )[4]? – Flanker

So how does this solution work if we need to base it on multiple columns? For example = we want the top by by cyl and color (assume there is a column for color) .. tried a bunch of things and none seem to work.. Thanks! – Favin

@Jeff the question in your comment isn't clear to me. Consider creating a new question where you can provide details needed to understand and answer your question. – Okeechobee

Answer 5

There are at least 4 ways to do this thing, however,each has some difference. We using u_id to group and using lift value to order/sort

1 dplyr traditional way

library(dplyr)
top10_final_subset1 = final_subset %>% arrange(desc(lift)) %>% group_by(u_id) %>% slice(1:10)

and if you switch the order of arrange(desc(lift)) and group_by(u_id) the result is essential the same.And if there is tie for equal lift value,it will slice to make sure each group has no more than 10 values, if you only have 5 lift value in the group, it will only gives you 5 results for that group.

2 dplyr topN way

library(dplyr)
top10_final_subset2 = final_subset %>% group_by(u_id) %>% top_n(10,lift)

this one if you have tie in lift value, say 15 same lift for the same u_id, you will got all 15 observations

3 data.table tail way

library(data.table)
final_subset = data.table(final_subset,key = "lift")
top10_final_subset3 = final_subset[,tail(.SD,10),,by = c("u_id")]

It has the same row numbers as the first way, however, there are some rows are different, I guess they are using diff random algorithm dealing with tie.

4 data.table .SD way

library(data.table)
top10_final_subset4 = final_subset[,.SD[order(lift,decreasing = TRUE),][1:10],by = "u_id"]

This way is the most "uniform" way,if in a group there are only 5 observation it will repeat value to make it to 10 observations and if there are ties it will still slice and only hold for 10 observations.

Keenakeenan

Answer 6

If there were a tie at the fourth position for mtcars$mpg then this should return all the ties:

top_mpg <- mtcars[ mtcars$mpg >= mtcars$mpg[order(mtcars$mpg, decreasing=TRUE)][4] , ]

> top_mpg
                mpg cyl disp  hp drat    wt  qsec vs am gear carb
Fiat 128       32.4   4 78.7  66 4.08 2.200 19.47  1  1    4    1
Honda Civic    30.4   4 75.7  52 4.93 1.615 18.52  1  1    4    2
Toyota Corolla 33.9   4 71.1  65 4.22 1.835 19.90  1  1    4    1
Lotus Europa   30.4   4 95.1 113 3.77 1.513 16.90  1  1    5    2

Since there is a tie at the 3-4 position you can test it by changing 4 to a 3, and it still returns 4 items. This is logical indexing and you might need to add a clause that removes the NA's or wrap which() around the logical expression. It's not much more difficult to do this "by" cyl:

 Reduce(rbind,  by(mtcars, mtcars$cyl, 
        function(d) d[ d$mpg >= d$mpg[order(d$mpg, decreasing=TRUE)][4] , ]) )
#-------------
                   mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Fiat 128          32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
Honda Civic       30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
Toyota Corolla    33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
Lotus Europa      30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
Mazda RX4         21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag     21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
Hornet 4 Drive    21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
Ferrari Dino      19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
Hornet Sportabout 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
Merc 450SE        16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
Merc 450SL        17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
Pontiac Firebird  19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

Incorporating my suggestion to @Ista:

Reduce(rbind,  by(mtcars, mtcars$cyl, function(d) d[ d$mpg <= sort( d$mpg )[3] , ]) )

Flanker

Don't know what you mean by not doing it if you don't know before hand. It will return all rows with mpg values at or above the fourth largest value. Again if you picked third largest as a target, you still get 4 items in the four-cylinder class. I thought that was one of Anthony's goals – Flanker

As I understood the tasks requested that was the correct answer for one of them dealing with ties. – Flanker

Ah, then we do understand the task differently. You want mtcars$mpg %in% sort( unique(mtcars$mpg))[1:3]. – Flanker

Answer 7

You can write a function that splits the database by a factor, orders by another desired variable, extract the number of rows you want in each factor (category) and combine these into a database.

top<-function(x, num, c1,c2){
sorted<-x[with(x,order(x[,c1],x[,c2],decreasing=T)),]
splits<-split(sorted,sorted[,c1])
df<-lapply(splits,head,num)
do.call(rbind.data.frame,df)}

x is the dataframe;

num is the number of number of rows you would like to see;

c1 is the column number of the variable you would like to split by;

c2 is the column number of the variable you would like to rank by or handle ties.

Using the mtcars data, the function extracts the 3 heaviest cars (mtcars$wt is the 6th column) in each cylinder class (mtcars$cyl is the 2nd column)

 top(mtcars,3,2,6)
                         mpg cyl  disp  hp drat    wt  qsec vs am gear carb
 4.Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
 4.Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
 4.Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
 6.Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
 6.Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
 6.Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
 8.Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
 8.Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
 8.Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4

You can also easily get the lightest in a class by changing head in the lapply function to tail OR by removing the decreasing=T argument in the order function which will return it to its default, decreasing=F.

Lacker

Answer 8

Since dplyr 1.0.0, the slice_max()/slice_min() functions were implemented:

mtcars %>%
 group_by(cyl) %>%
 slice_max(mpg, n = 2, with_ties = FALSE)

    mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1  33.9     4  71.1    65  4.22  1.84  19.9     1     1     4     1
2  32.4     4  78.7    66  4.08  2.2   19.5     1     1     4     1
3  21.4     6 258     110  3.08  3.22  19.4     1     0     3     1
4  21       6 160     110  3.9   2.62  16.5     0     1     4     4
5  19.2     8 400     175  3.08  3.84  17.0     0     0     3     2
6  18.7     8 360     175  3.15  3.44  17.0     0     0     3     2

The documentation on with_ties parameter:

Should ties be kept together? The default, TRUE, may return more rows than you request. Use FALSE to ignore ties, and return the first n rows.

Cusack

Answer 9

I prefer @Ista solution, cause needs no extra package and is simple.
A modification of the data.table solution also solve my problem, and is more general.
My data.frame is

> str(df)
'data.frame':   579 obs. of  11 variables:
 $ trees     : num  2000 5000 1000 2000 1000 1000 2000 5000 5000 1000 ...
 $ interDepth: num  2 3 5 2 3 4 4 2 3 5 ...
 $ minObs    : num  6 4 1 4 10 6 10 10 6 6 ...
 $ shrinkage : num  0.01 0.001 0.01 0.005 0.01 0.01 0.001 0.005 0.005 0.001     ...
 $ G1        : num  0 2 2 2 2 2 8 8 8 8 ...
 $ G2        : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
 $ qx        : num  0.44 0.43 0.419 0.439 0.43 ...
 $ efet      : num  43.1 40.6 39.9 39.2 38.6 ...
 $ prec      : num  0.606 0.593 0.587 0.582 0.574 0.578 0.576 0.579 0.588 0.585 ...
 $ sens      : num  0.575 0.57 0.573 0.575 0.587 0.574 0.576 0.566 0.542 0.545 ...
 $ acu       : num  0.631 0.645 0.647 0.648 0.655 0.647 0.619 0.611 0.591 0.594 ...

The data.table solution needs order on i to do the job:

> require(data.table)
> dt1 <- data.table(df)
> dt2 = dt1[order(-efet, G1, G2), head(.SD, 3), by = .(G1, G2)]
> dt2
    G1    G2 trees interDepth minObs shrinkage        qx   efet  prec  sens   acu
 1:  0 FALSE  2000          2      6     0.010 0.4395953 43.066 0.606 0.575 0.631
 2:  0 FALSE  2000          5      1     0.005 0.4294718 37.554 0.583 0.548 0.607
 3:  0 FALSE  5000          2      6     0.005 0.4395753 36.981 0.575 0.559 0.616
 4:  2 FALSE  5000          3      4     0.001 0.4296346 40.624 0.593 0.570 0.645
 5:  2 FALSE  1000          5      1     0.010 0.4186802 39.915 0.587 0.573 0.647
 6:  2 FALSE  2000          2      4     0.005 0.4390503 39.164 0.582 0.575 0.648
 7:  8 FALSE  2000          4     10     0.001 0.4511349 38.240 0.576 0.576 0.619
 8:  8 FALSE  5000          2     10     0.005 0.4469665 38.064 0.579 0.566 0.611
 9:  8 FALSE  5000          3      6     0.005 0.4426952 37.888 0.588 0.542 0.591
10:  2  TRUE  5000          3      4     0.001 0.3812878 21.057 0.510 0.479 0.615
11:  2  TRUE  2000          3     10     0.005 0.3790536 20.127 0.507 0.470 0.608
12:  2  TRUE  1000          5      4     0.001 0.3690911 18.981 0.500 0.475 0.611
13:  8  TRUE  5000          6     10     0.010 0.2865042 16.870 0.497 0.435 0.635
14:  0  TRUE  2000          6      4     0.010 0.3192862  9.779 0.460 0.433 0.621  

By some reason, it does not order the way pointed (probably because ordering by the groups). So, another ordering is done.

> dt2[order(G1, G2)]
    G1    G2 trees interDepth minObs shrinkage        qx   efet  prec  sens   acu
 1:  0 FALSE  2000          2      6     0.010 0.4395953 43.066 0.606 0.575 0.631
 2:  0 FALSE  2000          5      1     0.005 0.4294718 37.554 0.583 0.548 0.607
 3:  0 FALSE  5000          2      6     0.005 0.4395753 36.981 0.575 0.559 0.616
 4:  0  TRUE  2000          6      4     0.010 0.3192862  9.779 0.460 0.433 0.621
 5:  2 FALSE  5000          3      4     0.001 0.4296346 40.624 0.593 0.570 0.645
 6:  2 FALSE  1000          5      1     0.010 0.4186802 39.915 0.587 0.573 0.647
 7:  2 FALSE  2000          2      4     0.005 0.4390503 39.164 0.582 0.575 0.648
 8:  2  TRUE  5000          3      4     0.001 0.3812878 21.057 0.510 0.479 0.615
 9:  2  TRUE  2000          3     10     0.005 0.3790536 20.127 0.507 0.470 0.608
10:  2  TRUE  1000          5      4     0.001 0.3690911 18.981 0.500 0.475 0.611
11:  8 FALSE  2000          4     10     0.001 0.4511349 38.240 0.576 0.576 0.619
12:  8 FALSE  5000          2     10     0.005 0.4469665 38.064 0.579 0.566 0.611
13:  8 FALSE  5000          3      6     0.005 0.4426952 37.888 0.588 0.542 0.591
14:  8  TRUE  5000          6     10     0.010 0.2865042 16.870 0.497 0.435 0.635

Effuse

Answer 10

data.table way for picking the lowest 3 mpg per group:

data("mtcars")
setDT(mtcars)[order(mpg), head(.SD, 3), by = "cyl"]

Sweatt