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

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

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

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 … но ничего не работает. По любым предложениям я был бы очень благодарен.

9 Solutions collect form web for “Сохранять только минимальное значение для каждого уровня фактора”

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

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

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

 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 

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 подхода так же быстро, когда он будет реализован).

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

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

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

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

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

EDIT: в случае галстука это оставит только первую строку.

EDIT2: Впечатление от 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 

Вот решение для планшета;

 > 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 

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

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

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

Другой способ – использовать 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 

Вот решение с 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 

Это 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" или другие, как описано в файле справки.

  • Разделение столбца строки dataframe на несколько разных столбцов
  • Проверьте, если символы в строке в R
  • Что делает .SD в data.table в R
  • Изменение метки грани в математической формуле в ggplot2
  • Ошибка пропуска в петле
  • Как удалить пространство между осью и областью в ggplot2?
  • Форматирование десятичных знаков в R
  • Вызовите применимую функцию для каждой строки данных с несколькими аргументами из каждой строки
  • ggplot, facet, piechart: размещение текста в середине круговых диаграмм
  • Idiomatic R-код для разбиения вектора по индексу и выполнения операции над этим разделом
  • Ограничить оси ggplot2 без удаления данных (внешние ограничения): увеличить
  • Давайте будем гением компьютера.