code

그룹 별 최고 가치 얻기

codestyles 2020. 10. 23. 07:56
반응형

그룹 별 최고 가치 얻기


다음은 샘플 데이터 프레임입니다.

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

각 값에 대해 d상위 5 개 값이있는 행 포함 하는 하위 집합을 원합니다 .xgrp

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 개 행만 반환합니다.

스와핑 head에 대한 top_n전체 돌아갑니다 d.

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

올바른 하위 집합을 얻으려면 어떻게합니까?


에서 인수 ?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

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

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)

기본 R에서의 접근 방식은 다음과 같습니다.

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

그리고 dplyr을 사용하면 접근 방식 slice이 아마도 가장 빠르지 만 다음을 사용 filter하는 것보다 더 빠를 수도 있습니다 do(head(., 5)).

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

top_n(n = 1) will still return multiple rows for each group if the ordering variable is not unique within each group. In order to select precisely one occurence for each group, add an unique variable to each row:

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)

참고URL : https://stackoverflow.com/questions/27766054/getting-the-top-values-by-group

반응형