web-dev-qa-db-ja.com

データフレーム内の列を順序付けてグループ(四分位数、十分位数など)をすばやく形成する方法

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

より良い(よりクリーン/高速/ 1行の)アプローチはありますか?ありがとう!

60
Richard Herron

私が使用する方法は、次のいずれかまたは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= in cut、またはコードに次の行を追加できます。

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

または、それはもはや要因ではなく、数値ベクトルではありますが、動作はより迅速ですがわずかに不明瞭です:

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

パッケージntileには便利なdplyr関数があります。作成したい*タイルまたは「ビン」の数を非常に簡単に定義できるという意味で柔軟性があります。

パッケージをロードし(まだインストールしていない場合は最初にインストール)、四分位列を追加します。

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

データ:

事前に「四分位」列を作成し、set.seedを使用してランダム化を再現可能にする必要はないことに注意してください。

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

私はそれをグーグルする他の人のために_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)]
_

私がやっていたことよりもはるかに優れています(よりクリーンで、 faster ):

_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));で失敗します。この場合の対処方法は自由ですので、お任せします。

17
MichaelChirico

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
6
Gavin Simpson

dplyr::ntile最適化を利用してdata.tableを適応させると、より高速なソリューションが提供されます。

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

おそらくクリーナーとしての資格はありませんが、より高速で1行です。

より大きなデータセットでのタイミング

@docendo_discimusと@MichaelChiricoが提案したdata.tablentilecutに対するこのソリューションの比較。

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
5
EMuPi

パーティーに少し遅れてすみません。データの最大/最小がわからず、グループも同じ大きさにしたかったので、cut2を使用して1つのライナーを追加したかった。重複としてマークされた問題の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について詳細に読んだ同様の問題

3
maze

データセットのブレークオプションquantile()cut()を使用すると多くの問題に遭遇したため、より堅牢なバージョンを提案したいと思います。 ntileplyr関数を使用していますが、入力として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)
)]

あれは正しいですか?

0
hannes101

この機能を試してください

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
0
MaoXilin
temp$quartile <- ceiling(sapply(temp$value,function(x) sum(x-temp$value>=0))/(length(temp$value)/4))
0
James