Сохраняйте только минимальное значение для каждого уровня фактора

Question

У меня есть проблема, которая вызывает у меня некоторое время ... надеюсь, кто-нибудь здесь может мне помочь.

Я получил следующий фрейм данных

f <- c('a','a','b','b','b','c','d','d','d','d')
v1 <- c(1.3,10,2,10,10,1.1,10,3.1,10,10)
v2 <- c(1:10)
df <- data.frame(f,v1,v2)

f является фактором; v1 и v2 являются значениями. Для каждого уровня f я хочу сохранить только одну строку: ту, которая имеет наименьшее значение v1 на этом уровне фактора.

f   v1  v2
a   1.3 1
b   2   3
c   1.1 6
d   3.1 8

Я пробовал разные вещи с агрегатом, ddply, by, tapply ... но, похоже, ничего не работает. За любые предложения буду очень благодарен.

Answer 1

Используя решение DWin, tapply можно избежать, используя ave.

df[ df$v1 == ave(df$v1, df$f, FUN=min), ]

Это дает еще одно ускорение, как показано ниже. Имейте в виду, это также зависит от количества уровней. Я говорю об этом, когда замечаю, что о ave слишком часто забывают, хотя это одна из наиболее мощных функций в R.

f <- rep(letters[1:20],10000)
v1 <- rnorm(20*10000)
v2 <- 1:(20*10000)
df <- data.frame(f,v1,v2)

> system.time(df[ df$v1 == ave(df$v1, df$f, FUN=min), ])
   user  system elapsed 
   0.05    0.00    0.05 

> system.time(df[ df$v1 %in% tapply(df$v1, df$f, min), ])
   user  system elapsed 
   0.25    0.03    0.29 

> system.time(lapply(split(df, df$f), FUN = function(x) {
+             vec <- which(x[3] == min(x[3]))
+             return(x[vec, ])
+         })
+  .... [TRUNCATED] 
   user  system elapsed 
   0.56    0.00    0.58 

> system.time(df[tapply(1:nrow(df),df$f,function(i) i[which.min(df$v1[i])]),]
+ )
   user  system elapsed 
   0.17    0.00    0.19 

> system.time( ddply(df, .var = "f", .fun = function(x) {
+     return(subset(x, v1 %in% min(v1)))
+     }
+ )
+ )
   user  system elapsed 
   0.28    0.00    0.28 

Answer 2

A data.table раствор.

library(data.table)
DT <- as.data.table(df)
DT[,.SD[which.min(v1)], by = f]

##   f  v1 v2
## 1: a 1.3  1
## 2: b 2.0  3
## 3: c 1.1  6
## 4: d 3.1  8

Или, более эффективно

DT[DT[,.I[which.min(v1)],by=f][['V1']]]

некоторые тесты

f <- rep(letters[1:20],100000)
v1 <- rnorm(20*100000)
v2 <- 1:(20*100000)
df <- data.frame(f,v1,v2)
DT <- as.data.table(df)
f1<-function(){df2<-df[order(df$f,df$v1),]
               df2[!duplicated(df2$f),]}

f2<-function(){df2<-df[order(df$v1),]
               df2[!duplicated(df2$f),]}

f3<-function(){df[ df$v1 == ave(df$v1, df$f, FUN=min), ]}


f4 <- function(){DT[,.SD[which.min(v1)], by = f]}

f5 <- function(){DT[DT[,.I[which.min(v1)],by=f][['V1']]]}

library(microbenchmark)
microbenchmark(f1(),f2(),f3(),f4(), f5(),times = 5)
# Unit: milliseconds
# expr       min        lq    median        uq       max neval
# f1() 3254.6620 3265.4760 3286.5440 3411.4054 3475.4198     5
# f2() 1630.8572 1639.3472 1651.5422 1721.4670 1738.6684     5
# f3()  172.2639  174.0448  177.4985  179.9604  184.7365     5
# f4()  206.1837  209.8161  209.8584  210.4896  210.7893     5
# f5()  105.5960  106.5006  107.9486  109.7216  111.1286     5

Подход .I является победителем ( FR # 2330 , мы надеемся, так же быстро обеспечит элегантность подхода .SD при реализации).

Answer 3

С plyr я бы использовал:

ddply(df, .var = "f", .fun = function(x) {
    return(subset(x, v1 %in% min(v1)))
    }
)

Попробуйте и посмотрите, вернет ли он то, что вы хотите.

Answer 4

Другое решение tapply, без ненужного сканирования вектора с %in%:

df[tapply(1:nrow(df),df$f,function(i) i[which.min(df$v1[i])]),]

РЕДАКТИРОВАТЬ: Это оставит только первый ряд в случае связи.: Под впечатлением ave я внес дополнительные улучшения:

df[sapply(split(1:nrow(df),df$f),function(x) x[which.min(df$v1[x])]),]

На моей машине (используя данные тестов Joris):

> system.time(df[ df$v1 == ave(df$v1, df$f, FUN=min), ])
   user  system elapsed
  0.022   0.000   0.021
> system.time(df[sapply(split(1:nrow(df),df$f),function(x) x[which.min(df$v1[x])]),])
   user  system elapsed
  0.006   0.000   0.007

Answer 5

Вот подходящее решение;

> df[ df$v1 %in% tapply(df$v1, df$f, min), ]

  f  v1 v2
1 a 1.3  1
3 b 2.0  3
6 c 1.1  6
8 d 3.1  8

В вашем примере он выбирает только одного на группу, но если бы были связи, этот метод показал бы их все. (Я подозреваю, как и у Паркера и Луштрика.)

Answer 6

Это dplyr-способ фильтрации минимальных значений v1 по группам f:

require(dplyr)
df %>%
  group_by(f) %>%
  filter(v1 == min(v1))

#Source: local data frame [4 x 3]
#Groups: f
#
#  f  v1 v2
#1 a 1.3  1
#2 b 2.0  3
#3 c 1.1  6
#4 d 3.1  8

В случае связей в v1 это приведет к нескольким строкам нагруппа f.Если вы хотите избежать этого, вы можете использовать:

df %>% 
  group_by(f) %>% 
  filter(rank(v1, ties.method= "first") == 1)

Таким образом, вы получите только первый ряд в случае связей.Вы также можете использовать ties.method = "random" или другие, как описано в файле справки.

Answer 7

Вот решение с by

do.call(rbind, unname(by(df, df$f, function(x) x[x$v1 == min(x$v1),])))
##   f  v1 v2
## 1 a 1.3  1
## 3 b 2.0  3
## 6 c 1.1  6
## 8 d 3.1  8

Answer 8

Другой способ - использовать order и !duplicated, но вы получите только первое на связи.

df2 <- df[order(df$f,df$v1),]
df2[!duplicated(df2$f),]

  f  v1 v2
1 a 1.3  1
3 b 2.0  3
6 c 1.1  6
8 d 3.1  8

Задержка

f1<-function(){df2<-df[order(df$f,df$v1),]
df2[!duplicated(df2$f),]}

f2<-function(){df2<-df[order(df$v1),]
df2[!duplicated(df2$f),]}

f3<-function(){df[ df$v1 == ave(df$v1, df$f, FUN=min), ]}

library(rbenchmark)
> benchmark(f1(),f2(),f3())
  test replications elapsed relative user.self sys.self user.child sys.child
1 f1()          100   38.16 7.040590     36.66     1.48         NA        NA
2 f2()          100   20.54 3.789668     19.30     1.23         NA        NA
3 f3()          100    5.42 1.000000      4.96     0.46         NA        NA

Answer 9

Извините, мои мыслительные способности исчерпаны, и это уродливое решение - все, что я могу придумать почти в 1 час ночи.

lapply(split(df, df$f), FUN = function(x) {
            vec <- which(x[3] == min(x[3]))
            return(x[vec, ])
        })