如何通过对数据框中的列进行排序来快速形成组(四分位数,十分位数等)

Ric*_*ron 62 sorting r dataframe

我看到很多的问题和答案再ordersort.是否有任何将矢量或数据帧分类为分组(如四分位数或十分位数)的东西?我有一个"手动"解决方案,但可能有一个更好的解决方案已经过组测试.

这是我的尝试:

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
Run Code Online (Sandbox Code Playgroud)

是否有更好的(更清洁/更快/一线)方法?谢谢!

42-*_*42- 74

我使用的方法之一是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))
Run Code Online (Sandbox Code Playgroud)

替代方案可能是:

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")
      ))
Run Code Online (Sandbox Code Playgroud)

第一个有副作用标注四分位数值,我认为这是一个"好东西",但如果它不"对你有好处",或者评论中提出的有效问题是一个问题,你可以去使用版本2.您可以使用labels=in cut,或者您可以将此行添加到您的代码中:

temp$quartile <- factor(temp$quartile, levels=c("1","2","3","4") )
Run Code Online (Sandbox Code Playgroud)

或者甚至更快但稍微更模糊一些,虽然它不再是一个因素,而是一个数字向量:

temp$quartile <- as.numeric(temp$quartile)
Run Code Online (Sandbox Code Playgroud)

  • `cut()`有参数`labels`可以使用,因此你不需要`factor()`行 - 只需在你的第一行的`cut()`调用中添加`labels = 1:4`. (11认同)
  • Hmisc包还有一个cut2函数,其"m"参数切入"m"(大致)相等的部分. (3认同)

tal*_*lat 68

包中有一个方便的ntile功能dplyr.从某种意义上讲,它非常灵活,您可以非常轻松地定义要创建的*tile或"bin"的数量.

加载包(如果没有,先安装)并添加四分位列:

library(dplyr)
temp$quartile <- ntile(temp$value, 4)  
Run Code Online (Sandbox Code Playgroud)

或者,如果要使用dplyr语法:

temp <- temp %>% mutate(quartile = ntile(value, 4))
Run Code Online (Sandbox Code Playgroud)

两种情况的结果是:

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
Run Code Online (Sandbox Code Playgroud)

数据:

请注意,您无需事先创建"四分位"列,并可用于set.seed使随机化可重现:

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

  • 那应该解决端点的问题,还是?`temp < - temp%>%mutate(quartile = cut(x = ntile(value,100),breaks = seq(25,100,25),include.lowest = TRUE,right = FALSE,labels = FALSE)) (2认同)

Mic*_*ico 17

我将为data.table其他任何人添加该版本谷歌搜索它(即,@ BondedDust的解决方案被翻译成data.table并减少了一点):

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

哪个比我做的更好(更干净,更快):

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

但是请注意,这种方法要求分位数是不同的,例如它会失败rep(0:1, c(100, 1)); 在这种情况下该做什么是开放式的,所以我留给你.

  • 顺便提一下,data.table版本是最快的方法.谢谢@MichaelChirico. (2认同)

Rei*_*son 6

您可以使用该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))
Run Code Online (Sandbox Code Playgroud)

赠送:

> 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
Run Code Online (Sandbox Code Playgroud)


maz*_*aze 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
Run Code Online (Sandbox Code Playgroud)

结果:

> 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)
Run Code Online (Sandbox Code Playgroud)

我详细阅读 cut2 的类似问题


小智 5

适应dplyr::ntile利用data.table优化提供了更快的解决方案.

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

可能不符合清洁条件,但速度更快,更单线.

更大数据集的时间安排

比较这一解决方案ntile,并cutdata.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)]
)
Run Code Online (Sandbox Code Playgroud)

得到:

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
Run Code Online (Sandbox Code Playgroud)