web-dev-qa-db-ja.com

グループごとの上位値の取得

サンプルのデータフレームを次に示します。

d <- data.frame(
  x   = runif(90),
  grp = gl(3, 30)
)

dの各値に対してxの上位5つの値を持つ行を含むgrpのサブセットが必要です。

Base-Rを使用すると、私のアプローチは次のようになります。

ordered <- d[order(d$x, decreasing = TRUE), ]    
splits <- split(ordered, ordered$grp)
heads <- lapply(splits, head)
do.call(rbind, heads)
##              x grp
## 1.19 0.8879631   1
## 1.4  0.8844818   1
## 1.12 0.8596197   1
## 1.26 0.8481809   1
## 1.18 0.8461516   1
## 1.29 0.8317092   1
## 2.31 0.9751049   2
## 2.34 0.9269764   2
## 2.57 0.8964114   2
## 2.58 0.8896466   2
## 2.45 0.8888834   2
## 2.35 0.8706823   2
## 3.74 0.9884852   3
## 3.73 0.9837653   3
## 3.83 0.9375398   3
## 3.64 0.9229036   3
## 3.69 0.8021373   3
## 3.86 0.7418946   3

dplyrを使用して、これが機能することを期待しました。

d %>%
  arrange_(~ desc(x)) %>%
  group_by_(~ grp) %>%
  head(n = 5)

ただし、全体の上位5行のみを返します。

top_n のheadを交換すると、d全体が返されます。

d %>%
  arrange_(~ desc(x)) %>%
  group_by_(~ grp) %>%
  top_n(n = 5)

正しいサブセットを取得するにはどうすればよいですか？

rdata.tabledplyr
73
Richie Cotton

?top_nから、wt引数について：

順序付けに使用する変数[...] デフォルトは最後の変数 tblで」。

データセットの最後の変数は「grp」であり、これはランク付けする変数ではないため、top_nの試行は「d全体を返す」ことになります。したがって、データセットで「x」でランク付けする場合は、wt = xを指定する必要があります。

set.seed(123)
d <- data.frame(
  x   = runif(90),
  grp = gl(3, 30))

d %>%
  group_by(grp) %>%
  top_n(n = 5, wt = x)
#            x grp
# 1  0.9404673   1
# 2  0.9568333   1
# 3  0.8998250   1
# 4  0.9545036   1
# 5  0.9942698   1
# 6  0.9630242   2
# 7  0.9022990   2
# 8  0.8578277   2
# 9  0.7989248   2
# 10 0.8950454   2
# 11 0.8146400   3
# 12 0.8123895   3
# 13 0.9849570   3
# 14 0.8930511   3
# 15 0.8864691   3
104
Henrik

data.tableでも非常に簡単です...

library(data.table)
setorder(setDT(d), -x)[, head(.SD, 5), keyby = grp]

または

setorder(setDT(d), grp, -x)[, head(.SD, 5), by = grp]

または（各グループの.SDの呼び出しを避けるため、ビッグデータセットの場合は高速になるはずです）

setorder(setDT(d), grp, -x)[, indx := seq_len(.N), by = grp][indx <= 5]

編集：dplyrがdata.tableと比較される方法は次のとおりです（誰かが興味を持っている場合）

set.seed(123)
d <- data.frame(
  x   = runif(1e6),
  grp = sample(1e4, 1e6, TRUE))

library(dplyr)
library(microbenchmark)
library(data.table)
dd <- copy(d)

microbenchmark(
  top_n = {d %>%
             group_by(grp) %>%
             top_n(n = 5, wt = x)},
  dohead = {d %>%
              arrange_(~ desc(x)) %>%
              group_by_(~ grp) %>%
              do(head(., n = 5))},
  slice = {d %>%
             arrange_(~ desc(x)) %>%
             group_by_(~ grp) %>%
             slice(1:5)},
  filter = {d %>% 
              arrange(desc(x)) %>%
              group_by(grp) %>%
              filter(row_number() <= 5L)},
  data.table1 = setorder(setDT(dd), -x)[, head(.SD, 5L), keyby = grp],
  data.table2 = setorder(setDT(dd), grp, -x)[, head(.SD, 5L), grp],
  data.table3 = setorder(setDT(dd), grp, -x)[, indx := seq_len(.N), grp][indx <= 5L],
  times = 10,
  unit = "relative"
)


#        expr        min         lq      mean     median        uq       max neval
#       top_n  24.246401  24.492972 16.300391  24.441351 11.749050  7.644748    10
#      dohead 122.891381 120.329722 77.763843 115.621635 54.996588 34.114738    10
#       slice  27.365711  26.839443 17.714303  26.433924 12.628934  7.899619    10
#      filter  27.755171  27.225461 17.936295  26.363739 12.935709  7.969806    10
# data.table1  13.753046  16.631143 10.775278  16.330942  8.359951  5.077140    10
# data.table2  12.047111  11.944557  7.862302  11.653385  5.509432  3.642733    10
# data.table3   1.000000   1.000000  1.000000   1.000000  1.000000  1.000000    10

わずかに高速なdata.tableソリューションの追加：

set.seed(123L)
d <- data.frame(
    x   = runif(1e8),
    grp = sample(1e4, 1e8, TRUE))
setDT(d)
setorder(d, grp, -x)
dd <- copy(d)

library(microbenchmark)
microbenchmark(
    data.table3 = d[, indx := seq_len(.N), grp][indx <= 5L],
    data.table4 = dd[dd[, .I[seq_len(.N) <= 5L], grp]$V1],
    times = 10L
)

タイミング出力：

Unit: milliseconds
        expr      min       lq     mean   median        uq      max neval
 data.table3 826.2148 865.6334 950.1380 902.1689 1006.1237 1260.129    10
 data.table4 729.3229 783.7000 859.2084 823.1635  966.8239 1014.397    10
35
David Arenburg

head への呼び出しでdoをラップする必要があります。次のコードでは、.は現在のグループを表します（doヘルプページの...の説明を参照）。

d %>%
  arrange_(~ desc(x)) %>%
  group_by_(~ grp) %>%
  do(head(., n = 5))

Akrunで述べたように、sliceは代替です。

d %>%
  arrange_(~ desc(x)) %>%
  group_by_(~ grp) %>%
  slice(1:5)
25
Richie Cotton

ベースRでの私のアプローチは次のようになります。

ordered <- d[order(d$x, decreasing = TRUE), ]
ordered[ave(d$x, d$grp, FUN = seq_along) <= 5L,]

また、dplyrを使用すると、sliceを使用したアプローチがおそらく最も高速になりますが、do(head(., 5))を使用するよりも高速なfilterを使用することもできます。

d %>% 
  arrange(desc(x)) %>%
  group_by(grp) %>%
  filter(row_number() <= 5L)

dplyrベンチマーク

set.seed(123)
d <- data.frame(
  x   = runif(1e6),
  grp = sample(1e4, 1e6, TRUE))

library(microbenchmark)

microbenchmark(
  top_n = {d %>%
             group_by(grp) %>%
             top_n(n = 5, wt = x)},
  dohead = {d %>%
              arrange_(~ desc(x)) %>%
              group_by_(~ grp) %>%
              do(head(., n = 5))},
  slice = {d %>%
             arrange_(~ desc(x)) %>%
             group_by_(~ grp) %>%
             slice(1:5)},
  filter = {d %>% 
              arrange(desc(x)) %>%
              group_by(grp) %>%
              filter(row_number() <= 5L)},
  times = 10,
  unit = "relative"
)

Unit: relative
   expr       min        lq    median        uq       max neval
  top_n  1.042735  1.075366  1.082113  1.085072  1.000846    10
 dohead 18.663825 19.342854 19.511495 19.840377 17.433518    10
  slice  1.000000  1.000000  1.000000  1.000000  1.000000    10
 filter  1.048556  1.044113  1.042184  1.180474  1.053378    10
14
docendo discimus

ordering変数が各グループ内で一意でない場合、top_n（n = 1）は各グループに対して複数の行を返します。グループごとに1つのオカレンスを正確に選択するには、各行に一意の変数を追加します。

set.seed(123)
d <- data.frame(
  x   = runif(90),
  grp = gl(3, 30))

d %>%
  mutate(rn = row_number()) %>% 
  group_by(grp) %>%
  top_n(n = 1, wt = rn)
1
Jan Vydra