Как быстро сформировать группы (квартили, децили и т. Д.), Упорядочив столбцы в кадре данных

Question

Я вижу много вопросов и ответов о order и sort.Есть ли что-нибудь, что сортирует векторы или фреймы данных по группам (например, квартили или децили)?У меня есть «ручное» решение, но, вероятно, есть лучшее решение, прошедшее групповую проверку.

Вот моя попытка:

temp <- data.frame(name=letters[1:12], value=rnorm(12), quartile=rep(NA, 12))
temp
#    name       value quartile
# 1     a  2.55118169       NA
# 2     b  0.79755259       NA
# 3     c  0.16918905       NA
# 4     d  1.73359245       NA
# 5     e  0.41027113       NA
# 6     f  0.73012966       NA
# 7     g -1.35901658       NA
# 8     h -0.80591167       NA
# 9     i  0.48966739       NA
# 10    j  0.88856758       NA
# 11    k  0.05146856       NA
# 12    l -0.12310229       NA
temp.sorted <- temp[order(temp$value), ]
temp.sorted$quartile <- rep(1:4, each=12/4)
temp <- temp.sorted[order(as.numeric(rownames(temp.sorted))), ]
temp
#    name       value quartile
# 1     a  2.55118169        4
# 2     b  0.79755259        3
# 3     c  0.16918905        2
# 4     d  1.73359245        4
# 5     e  0.41027113        2
# 6     f  0.73012966        3
# 7     g -1.35901658        1
# 8     h -0.80591167        1
# 9     i  0.48966739        3
# 10    j  0.88856758        4
# 11    k  0.05146856        2
# 12    l -0.12310229        1

Есть ли лучшее (чище / быстрее / одноЛинейный) подход?Спасибо!

Answer 1

Метод, который я использую, является одним из них или Hmisc::cut2(value, g=4):

temp$quartile <- with(temp, cut(value, 
                                breaks=quantile(value, probs=seq(0,1, by=0.25), na.rm=TRUE), 
                                include.lowest=TRUE))

Альтернативой может быть:

temp$quartile <- with(temp, factor(
                            findInterval( val, c(-Inf,
                               quantile(val, probs=c(0.25, .5, .75)), Inf) , na.rm=TRUE), 
                            labels=c("Q1","Q2","Q3","Q4")
      ))

У первого есть побочный эффект маркировки квартилей ценностями, которые я считаю «хорошими», но если это не «хорошо для вас», или проблемы, поднятые в комментариях, были проблемой вы можете перейти с версии 2. Вы можете использовать labels= в cut, или вы можете добавить эту строку в свой код:

temp$quartile <- factor(temp$quartile, levels=c("1","2","3","4") )

Или даже быстрее, но немного более непонятно, как это работает, хотя это уже не фактор, а числовой вектор:

temp$quartile <- as.numeric(temp$quartile)

Answer 2

В пакете dplyr есть удобная функция ntile.Он гибок в том смысле, что вы можете очень легко определить количество * плиток или «корзин», которые вы хотите создать.

Загрузите пакет (установите сначала, если у вас его нет) и добавьте столбец квартиля:

library(dplyr)
temp$quartile <- ntile(temp$value, 4)  

Или, если вы хотите использовать синтаксис dplyr:

temp <- temp %>% mutate(quartile = ntile(value, 4))

Результат в обоих случаях:

temp
#   name       value quartile
#1     a -0.56047565        1
#2     b -0.23017749        2
#3     c  1.55870831        4
#4     d  0.07050839        2
#5     e  0.12928774        3
#6     f  1.71506499        4
#7     g  0.46091621        3
#8     h -1.26506123        1
#9     i -0.68685285        1
#10    j -0.44566197        2
#11    k  1.22408180        4
#12    l  0.35981383        3

data:

Обратите внимание, что вам не нужно заранее создавать столбец "квартили" и используйте set.seed для рандомизации.Воспроизводимый:

set.seed(123)
temp <- data.frame(name=letters[1:12], value=rnorm(12))

Answer 3

Я добавлю версию data.table для всех, кто ищет ее в Google (т. Е. Решение @ BondedDust переведено на data.table и немного уменьшено):

library(data.table)
setDT(temp)
temp[ , quartile := cut(value,
                        breaks = quantile(value, probs = 0:4/4),
                        labels = 1:4, right = FALSE)]

Что гораздо лучше (чище, быстрее ) чем то, что я делал:

temp[ , quartile := 
        as.factor(ifelse(value < quantile(value, .25), 1,
                         ifelse(value < quantile(value, .5), 2,
                                ifelse(value < quantile(value, .75), 3, 4))]

Обратите внимание, однако, что этот подход требует, чтобы квантили были различимы, например, он потерпит неудачу на rep(0:1, c(100, 1));что делать в этом случае является открытым, поэтому я оставляю это на ваше усмотрение.

Answer 4

Вы можете использовать функцию quantile(), но вам необходимо обрабатывать округление / точность при использовании cut().Итак

set.seed(123)
temp <- data.frame(name=letters[1:12], value=rnorm(12), quartile=rep(NA, 12))
brks <- with(temp, quantile(value, probs = c(0, 0.25, 0.5, 0.75, 1)))
temp <- within(temp, quartile <- cut(value, breaks = brks, labels = 1:4, 
                                     include.lowest = TRUE))

Даёшь:

> head(temp)
  name       value quartile
1    a -0.56047565        1
2    b -0.23017749        2
3    c  1.55870831        4
4    d  0.07050839        2
5    e  0.12928774        3
6    f  1.71506499        4

Answer 5

Адаптация dplyr::ntile для использования преимуществ data.table обеспечивает более быстрое решение.

library(data.table)
setDT(temp)
temp[order(value) , quartile := floor( 1 + 4 * (.I-1) / .N)]

Вероятно, не считается более чистым, но он быстрее и в одну строку.

Время на большем наборе данных

Сравнение этого решения с ntile и cut для data.table, как предложено @docendo_discimus и @ MichaelChirico.

library(microbenchmark)
library(dplyr)

set.seed(123)

n <- 1e6
temp <- data.frame(name=sample(letters, size=n, replace=TRUE), value=rnorm(n))
setDT(temp)

microbenchmark(
    "ntile" = temp[, quartile_ntile := ntile(value, 4)],
    "cut" = temp[, quartile_cut := cut(value,
                                       breaks = quantile(value, probs = seq(0, 1, by=1/4)),
                                       labels = 1:4, right=FALSE)],
    "dt_ntile" = temp[order(value), quartile_ntile_dt := floor( 1 + 4 * (.I-1)/.N)]
)

Дает:

Unit: milliseconds
     expr      min       lq     mean   median       uq      max neval
    ntile 608.1126 647.4994 670.3160 686.5103 691.4846 712.4267   100
      cut 369.5391 373.3457 375.0913 374.3107 376.5512 385.8142   100
 dt_ntile 117.5736 119.5802 124.5397 120.5043 124.5902 145.7894   100

Answer 6

Извините, что немного опоздал на вечеринку.Я хотел добавить свой один вкладыш, используя cut2, так как я не знал макс / мин для своих данных и хотел, чтобы группы были одинаково большими.Я прочитал о cut2 в выпуске, который был помечен как дубликат (ссылка ниже).

library(Hmisc)   #For cut2
set.seed(123)    #To keep answers below identical to my random run

temp <- data.frame(name=letters[1:12], value=rnorm(12), quartile=rep(NA, 12))

temp$quartile <- as.numeric(cut2(temp$value, g=4))   #as.numeric to number the factors
temp$quartileBounds <- cut2(temp$value, g=4)

temp

Результат:

> temp
   name       value quartile  quartileBounds
1     a -0.56047565        1 [-1.265,-0.446)
2     b -0.23017749        2 [-0.446, 0.129)
3     c  1.55870831        4 [ 1.224, 1.715]
4     d  0.07050839        2 [-0.446, 0.129)
5     e  0.12928774        3 [ 0.129, 1.224)
6     f  1.71506499        4 [ 1.224, 1.715]
7     g  0.46091621        3 [ 0.129, 1.224)
8     h -1.26506123        1 [-1.265,-0.446)
9     i -0.68685285        1 [-1.265,-0.446)
10    j -0.44566197        2 [-0.446, 0.129)
11    k  1.22408180        4 [ 1.224, 1.715]
12    l  0.35981383        3 [ 0.129, 1.224)

Аналогичный вопрос, в котором я подробно читал о cut2

Answer 7

Попробуйте эту функцию

getQuantileGroupNum <- function(vec, group_num, decreasing=FALSE) {
  if(decreasing) {
    abs(cut(vec, quantile(vec, probs=seq(0, 1, 1 / group_num), type=8, na.rm=TRUE), labels=FALSE, include.lowest=T) - group_num - 1)
  } else {
    cut(vec, quantile(vec, probs=seq(0, 1, 1 / group_num), type=8, na.rm=TRUE), labels=FALSE, include.lowest=T)
  }
}

> t1 <- runif(7)
> t1
[1] 0.4336094 0.2842928 0.5578876 0.2678694 0.6495285 0.3706474 0.5976223
> getQuantileGroupNum(t1, 4)
[1] 2 1 3 1 4 2 4
> getQuantileGroupNum(t1, 4, decreasing=T)
[1] 3 4 2 4 1 3 1

Answer 8

Я хотел бы предложить версию, которая кажется более надежной, поскольку я столкнулся с множеством проблем, используя quantile() в опции breaks cut() в моем наборе данных. Я использую ntile функцию plyr, но она также работает с ecdf в качестве ввода.

temp[, `:=`(quartile = .bincode(x = ntile(value, 100), breaks = seq(0,100,25), right = TRUE, include.lowest = TRUE)
            decile = .bincode(x = ntile(value, 100), breaks = seq(0,100,10), right = TRUE, include.lowest = TRUE)
)]

temp[, `:=`(quartile = .bincode(x = ecdf(value)(value), breaks = seq(0,1,0.25), right = TRUE, include.lowest = TRUE)
            decile = .bincode(x = ecdf(value)(value), breaks = seq(0,1,0.1), right = TRUE, include.lowest = TRUE)
)]

Это правильно?

Answer 9

temp$quartile <- ceiling(sapply(temp$value,function(x) sum(x-temp$value>=0))/(length(temp$value)/4))

Answer 10

Возможно, есть более быстрый путь, но я бы сделал:

a <- rnorm(100) # Our data
q <- quantile(a) # You can supply your own breaks, see ?quantile

# Define a simple function that checks in which quantile a number falls
getQuant <- function(x)
   {
   for (i in 1:(length(q)-1))
       {
       if (x>=q[i] && x<q[i+1])
          break;
       }
   i
   }

# Apply the function to the data
res <- unlist(lapply(as.matrix(a), getQuant))