快速計算多列上的 CDF/滾動連接
[英]Fast calculation of CDF / rolling join on multiple columns
問題描述
我正在嘗試在多元環境中測量某些數據的經驗累積分布。 也就是說，給定一個數據集，如
library(data.table) # v 1.9.7
set.seed(2016)
dt <- data.table(x=rnorm(1000), y=rnorm(1000), z=rnorm(1000))
dt
x y z
1: -0.91474 2.07025 -1.7499
2: 1.00125 -1.80941 -1.3856
3: -0.05642 1.58499 0.8110
4: 0.29665 -1.16660 0.3757
5: -2.79147 -1.75526 1.2851
---
996: 0.63423 0.13597 -2.3710
997: 0.21415 1.03161 -1.5440
998: 1.15357 -1.63713 0.4191
999: 0.79205 -0.56119 0.6670
1000: 0.19502 -0.05297 -0.3288
我想計算樣本的數量，例如 (x <= X, y <= Y, z <= Z) 對於一些 (X, Y, Z) 上限的網格，例如
bounds <- CJ(X=seq(-2, 2, by=.1), Y=seq(-2, 2, by=.1), Z=seq(-2, 2, by=.1))
bounds
X Y Z
1: -2 -2 -2.0
2: -2 -2 -1.9
3: -2 -2 -1.8
4: -2 -2 -1.7
5: -2 -2 -1.6
---
68917: 2 2 1.6
68918: 2 2 1.7
68919: 2 2 1.8
68920: 2 2 1.9
68921: 2 2 2.0
現在，我發現我可以優雅地做到這一點（使用非對等連接）
dt[, Count := 1]
result <- dt[bounds, on=c("x<=X", "y<=Y", "z<=Z"), allow.cartesian=TRUE][, list(N.cum = sum(!is.na(Count))), keyby=list(X=x, Y=y, Z=z)]
result[, CDF := N.cum/nrow(dt)]
result
X Y Z N.cum CDF
1: -2 -2 -2.0 0 0.000
2: -2 -2 -1.9 0 0.000
3: -2 -2 -1.8 0 0.000
4: -2 -2 -1.7 0 0.000
5: -2 -2 -1.6 0 0.000
---
68917: 2 2 1.6 899 0.899
68918: 2 2 1.7 909 0.909
68919: 2 2 1.8 917 0.917
68920: 2 2 1.9 924 0.924
68921: 2 2 2.0 929 0.929
但是當我開始增加 bin 數量時，這種方法確實效率低下並且變得非常慢。 我認為data.table的滾動連接功能的多元版本可以data.table ，但據我所知這是不可能的。 有什么建議可以加快速度嗎？
4 個解決方案
解決方案1
5 已采納 2016-11-14 07:31:29
想通了。
# Step1 - map each sample to the nearest X, Y, and Z above it. (In other words, bin the data.)
X <- data.table(X=seq(-2, 2, by=.1)); X[, x := X]
Y <- data.table(Y=seq(-2, 2, by=.1)); Y[, y := Y]
Z <- data.table(Z=seq(-2, 2, by=.1)); Z[, z := Z]
dt <- X[dt, on="x", roll=-Inf, nomatch=0]
dt <- Y[dt, on="y", roll=-Inf, nomatch=0]
dt <- Z[dt, on="z", roll=-Inf, nomatch=0]
# Step2 - aggregate by unique (X, Y, Z) triplets and count the samples directly below each of these bounds.
bg <- dt[, .N, keyby=list(X, Y, Z)]
# Step4 - Get the count of samples directly below EVERY (X, Y, Z) bound
bounds <- CJ(X=X$X, Y=Y$Y, Z=Z$Z)
kl <- bg[bounds, on=c("X", "Y", "Z")]
kl[is.na(N), N := 0]
# Step5 (the tricky part) - Consider a single (Y, Z) pair. X will be in ascending order. So we can do a cumsum on X for each (Y, Z) to count x <= X | Y,Z. Now if you hold X and Z fixed, you can do a cumsum on Y (which is also in ascending order) to count x <= X, y <= Y | Z. And then just continue this process.
kl[, CountUntil.XgivenYZ := cumsum(N), by=list(Y, Z)]
kl[, CountUntil.XYgivenZ := cumsum(CountUntil.XgivenYZ), by=list(X, Z)]
kl[, CountUntil.XYZ := cumsum(CountUntil.XYgivenZ), by=list(X, Y)]
# Cleanup
setnames(kl, "CountUntil.XYZ", "N.cum")
kl[, CDF := N.cum/nrow(dt)]
概括
對於任何想要它的人，我將其概括為可以處理任意數量的變量，並將該函數轉儲到我的 R 包mltools 中。
例如，要解決此問題，您可以執行以下操作
library(mltools)
bounds <- list(x=seq(-2, 2, by=.1), y=seq(-2, 2, by=.1), z=seq(-2, 2, by=.1))
empirical_cdf(x=dt, ubounds=bounds)
x y z N.cum CDF
1: -2 -2 -2.0 0 0.000
2: -2 -2 -1.9 0 0.000
3: -2 -2 -1.8 0 0.000
4: -2 -2 -1.7 0 0.000
5: -2 -2 -1.6 0 0.000
---
68917: 2 2 1.6 899 0.899
68918: 2 2 1.7 909 0.909
68919: 2 2 1.8 917 0.917
68920: 2 2 1.9 924 0.924
68921: 2 2 2.0 929 0.929
解決方案2
3 2016-11-21 03:59:30
更新
下面，我提供了一個通用的base R解決方案（它將適用於非均勻網格）。 它比由OP（更多關於這個版本）提供最快的出版解決方案快。 正如 OP 所暗示的，生成N.cum列是真正的瓶頸，所以我將我的精力集中在這個任務上（即，一旦獲得N.cum生成CDF是一項微不足道的任務）。
JoeBase <- function(dtt, s) {
m <- matrix(c(dtt$x, dtt$y, dtt$z), ncol = 3)
N.Cum <- array(vector(mode = "integer"), dim = rev(sapply(s, length)))
for (i in seq_along(s[[1]])) {
t1 <- m[,1] <= s[[1]][i]
for (j in seq_along(s[[2]])) {
t2 <- t1 & (m[,2] <= s[[2]][j])
for (k in seq_along(s[[3]])) {
N.Cum[k,j,i] <- sum(t2 & (m[,3] <= s[[3]][k]))
}
}
}
as.vector(N.Cum)
}
上述算法利用了向量化操作，特別是邏輯向量t1和t2的創建和利用。 該向量用於獲取滿足原始數據表中所有 3 列條件的行數。 我們只是依靠 R 的內部強制，通過sum的作用從邏輯向量到積分向量。
弄清楚如何填充 3 維整數數組N.Cum是一個挑戰，因為它稍后將通過as.vector轉換為向量。 這需要一些試驗和錯誤來了解as.vector行為。 令我驚訝的是，必須對“最后”和“第一”維度進行置換，以便忠實地強制轉換為向量（前幾次，我有 N.Cum[i,j,k] 而不是 N .Cum[k,j,i])。
首先，讓我們測試相等性：
library(data.table)
## Here is the function I used to test against. I included the generation
## of "bounds" and "bg" as "result" depends on both of these (N.B. "JoeBase" does not)
BenDT <- function(dt, s) {
X <- data.table(X=s[[1]]); X[, x := X]
Y <- data.table(Y=s[[2]]); Y[, y := Y]
Z <- data.table(Z=s[[3]]); Z[, z := Z]
dt <- X[dt, on="x", roll=-Inf, nomatch=0]
dt <- Y[dt, on="y", roll=-Inf, nomatch=0]
dt <- Z[dt, on="z", roll=-Inf, nomatch=0]
bg <- dt[, .N, keyby=list(X, Y, Z)]
bounds <- CJ(X=X$X, Y=Y$Y, Z=Z$Z)
kl <- bg[bounds, on=c("X", "Y", "Z")]
kl[is.na(N), N := 0]
# Counting
kl[, CountUntil.XgivenYZ := cumsum(N), by=list(Y, Z)]
kl[, CountUntil.XYgivenZ := cumsum(CountUntil.XgivenYZ), by=list(X, Z)]
kl[, CountUntil.XYZ := cumsum(CountUntil.XYgivenZ), by=list(X, Y)]
# Cleanup
setnames(kl, "CountUntil.XYZ", "N.cum")
kl[, CDF := N.cum/nrow(dt)]
kl
}
t1 <- BenDT(dt, seq(-2,2,0.1))
t2 <- JoeBase(dt, seq(-2,2,0.1))
all.equal(t1$N.cum, t2)
[1] TRUE
現在，我們測試速度。 首先，我們將使用compiler包中的cmpfun編譯這兩個函數。 第一個基准反映了較小示例的效率。
library(compiler)
c.JoeBase <- cmpfun(JoeBase)
c.BenDT <- cmpfun(BenDT)
c.OldBenDT <- cmpfun(OldBenDT) ## The previous best solution that Ben contributed
st <- list(seq(-2, 2, 0.1), seq(-2, 2, 0.1), seq(-2, 2, 0.1))
microbenchmark(c.BenDT(dt, st), c.OldBenDT(dt, st), c.JoeBase(dt, st), times = 10)
Unit: milliseconds
expr min lq mean median uq max neval cld
c.BenDT(dt, st) 34.24872 34.78908 38.87775 37.4924 43.37179 46.12859 10 a
c.OldBenDT(dt, st) 1485.68178 1532.35878 1607.96669 1593.9813 1619.58908 1845.75876 10 b
c.JoeBase(dt, st) 1880.71648 1962.38160 2049.43985 2007.4880 2169.93078 2281.02118 10 c
下面是舊測試。
st <- list(seq(-5, 5, 0.1), seq(-5, 5, 0.1), seq(-5, 5, 0.1))
microbenchmark(c.JoeBase(dt, st), c.OldBenDT(dt, st), times = 5)
Unit: seconds
expr min lq mean median uq max neval cld
c.JoeBase(dt, st) 23.50927 23.53809 29.61145 24.52748 30.81485 45.66759 5 a
c.OldBenDT(dt, st) 110.60209 123.95285 133.74601 124.97929 125.96186 183.23394 5 b
在進行了進一步的測試后，我對結果有些疑慮（@Ben 在評論中指出了類似的情緒）。 我很確定c.JoeBase看起來更快只是因為我的舊電腦的限制。 正如@stephematician 在他的回答中指出的那樣，原始解決方案是內存密集型的，如果您只是在c.OldBenDT上執行system.time ，您將看到大部分時間都花在了system類別和user category 相當於c.JoeBase的user類別。 我 6 歲的 Mac 只有 4GB 的內存，我推測這些操作會發生大量內存交換。 觀察：
## test with very tiny buckets (i.e. 0.025 instead of 0.1 above)
st <- list(seq(-1.5, 1.5, 0.025), seq(-1.5, 1.5, 0.025), seq(-1.5, 1.5, 0.025))
system.time(c.JoeBase(dt, st))
user system elapsed
36.407 4.748 41.170
system.time(c.OldBenDT(dt, st))
user system elapsed
49.653 77.954 475.304
system.time(c.BenDT(dt, st)) ## Ben's new solution is lightning fast
user system elapsed
0.603 0.063 0.668
無論如何，@Ben 的最新解決方案要優越得多。 查看這些新基准：
st <- list(seq(-5, 5, 0.1), seq(-5, 5, 0.1), seq(-5, 5, 0.1))
microbenchmark(c.JoeBase(dt, st), BenDT(dt, st), times = 5)
Unit: milliseconds
expr min lq mean median uq max neval cld
c.JoeBase(dt, st) 26517.0944 26855.7819 28341.5356 28403.7871 29926.213 30004.8018 5 b
BenDT(dt, st) 342.4433 359.8048 400.3914 379.5319 423.336 496.8411 5 a
data.table又一次勝利。
解決方案3
2 2016-11-21 00:11:28
只是一個關於替代方案的說明，然而，顯而易見的解決方案：
set.seed(2016)
dt <- data.table(x=rnorm(20000), y=rnorm(20000), z=rnorm(20000))
system.time({
dt <- t(as.matrix(dt))
bounds <- as.matrix(expand.grid(z=seq(-2,2,0.1),
y=seq(-2,2,0.1),
x=seq(-2,2,0.1)))
bounds <- bounds[,ncol(bounds):1]
n_d <- ncol(bounds)
x <- apply(bounds,
1,
function(x) sum(colSums(dt < x) == n_d))
})
我機器上的這個解決方案的計算時間大約是發布的 JoeBase 和 OldBenDT 解決方案的兩倍。 主要區別？ 內存使用。 它更受處理器限制。
我不知道在 R 中比較內存使用情況的精確方法，但是memory.size(max=T)函數報告說，對於以前的方法（不是非等連接方法）使用 5Gb 的內存，而只使用了 40Mb apply方法的內存（注意：我在樣本分布中使用了 20000 個點）。
我認為這對您可以執行的計算規模具有重要意義。
解決方案4
0 2016-11-17 18:44:08
應該更快地計算比例並一步完成連接，這樣中間結果就不必具體化。 感謝您的評論，我編輯了更正：
set.seed(2016)
dt <- data.table(x = rnorm(1000), y = rnorm(1000), z = rnorm(1000))
setkey(dt)
bounds <- CJ(x = seq(-2, 2, by= .1 ), y = seq(-2, 2, by = .1), z = seq(-2, 2, by = .1))
n_rows_dt <- nrow(dt)
A <- dt[bounds, .N / n_rows_dt , on = c("x<=x","y<=y","z<=z"),
by = .EACHI,
allow.cartesian = T]
滾動獨立地連接多列以消除NA
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.