Comment former rapidement des groupes (quartiles, déciles, etc.) en triant des colonnes dans un bloc de données
Je vois beaucoup de questions et réponses concernant order et sort. Existe-t-il quelque chose qui trie les vecteurs ou les cadres de données en groupes (comme des quartiles ou des déciles)? J'ai une solution "manuelle", mais il y a probablement une meilleure solution qui a été testée en groupe.
Voici ma tentative:
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
Existe-t-il une meilleure approche (plus propre/plus rapide/une ligne)? Merci!
La méthode que j'utilise est l'une de celles-ci ou 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))
Un remplaçant pourrait être:
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")
))
Le premier a pour effet secondaire de marquer les quartiles avec les valeurs, ce que je considère comme une "bonne chose", mais si ce n'était pas "bon pour vous" ou si les problèmes valides soulevés dans les commentaires étaient une préoccupation, vous pourriez aller avec la version 2. Vous pouvez utiliser labels= dans cut ou ajouter cette ligne à votre code:
temp$quartile <- factor(temp$quartile, levels=c("1","2","3","4") )
Ou même plus rapide mais légèrement plus obscur dans son fonctionnement, bien que ce ne soit plus un facteur, mais plutôt un vecteur numérique:
temp$quartile <- as.numeric(temp$quartile)
Il y a une fonction pratique ntile dans le paquet dplyr. Il est flexible dans le sens où vous pouvez très facilement définir le nombre de * tuiles ou "bacs" que vous souhaitez créer.
Chargez le package (installez d'abord si vous ne l'avez pas déjà fait) et ajoutez la colonne quartile:
library(dplyr)
temp$quartile <- ntile(temp$value, 4)
Ou, si vous souhaitez utiliser la syntaxe dplyr:
temp <- temp %>% mutate(quartile = ntile(value, 4))
Le résultat dans les deux cas est:
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
les données:
Notez qu'il n'est pas nécessaire de créer la colonne "quartile" à l'avance et d'utiliser set.seed pour rendre la randomisation reproductible:
set.seed(123)
temp <- data.frame(name=letters[1:12], value=rnorm(12))
J'ajouterai la version data.table à quiconque le recherchera (c'est-à-dire, la solution de @ BondedDust traduite en data.table et réduite un peu):
library(data.table)
setDT(temp)
temp[ , quartile := cut(value,
breaks = quantile(value, probs = 0:4/4),
labels = 1:4, right = FALSE)]
Ce qui est bien meilleur (plus propre, plus rapide ) que ce que je faisais auparavant:
temp[ , quartile :=
as.factor(ifelse(value < quantile(value, .25), 1,
ifelse(value < quantile(value, .5), 2,
ifelse(value < quantile(value, .75), 3, 4))]
Notez cependant que cette approche nécessite que les quantiles soient distincts, par ex. il échouera sur rep(0:1, c(100, 1)); ce qu'il faut faire dans ce cas est ouvert, donc je vous laisse le soin.
Vous pouvez utiliser la fonction quantile(), mais vous devez gérer l'arrondi/la précision lorsque vous utilisez cut(). Alors
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))
Donnant:
> 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
L'adaptation de dplyr::ntile pour tirer parti des optimisations de data.table constitue une solution plus rapide.
library(data.table)
setDT(temp)
temp[order(value) , quartile := floor( 1 + 4 * (.I-1) / .N)]
N'est probablement pas qualifié de nettoyeur, mais c'est plus rapide et linéaire.
Chronométrage sur un plus grand ensemble de données
Comparaison de cette solution à ntile et cut pour data.table proposée par @docendo_discimus et @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)]
)
Donne:
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
Désolé d'être un peu en retard à la fête. Je voulais ajouter ma seule couche en utilisant cut2 car je ne connaissais pas les valeurs max/min de mes données et je voulais que les groupes soient identiques. J'ai lu un article sur cut2 dans un numéro marqué en double (lien ci-dessous).
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
Résultat:
> 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)
Je voudrais proposer une version, qui semble être plus robuste, car j’ai rencontré beaucoup de problèmes avec quantile() dans l’option cut() de mon jeu de données . J'utilise la fonction ntile de plyr, mais cela fonctionne aussi avec ecdf en entrée.
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)
)]
Est-ce exact?
Essayez cette fonction
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
temp$quartile <- ceiling(sapply(temp$value,function(x) sum(x-temp$value>=0))/(length(temp$value)/4))