Question

我编写了以下函数来使用所谓的Cramér's V来估计多项式变量的成对相关性。为此目的，我使用vcd包，但据我所知，没有现有函数可以从矩阵创建V的对称相关矩阵，或者data.frame类似于cor。

功能是：

require(vcd)
get.V<-function(y){
  col.y<-ncol(y)
  V<-matrix(ncol=col.y,nrow=col.y)
  for(i in 1:col.y){
    for(j in 1:col.y){
      V[i,j]<-assocstats(table(y[,i],y[,j]))$cramer
    }
  }
  return(V)
}

但是，对于大量变量，它变得相对较慢。

no.var<-5
y<-matrix(ncol=no.var,sample(1:5,100*no.var,TRUE))
get.V(y)

当你增加no.var时，计算时间可能会爆炸。由于我需要将其应用于长度为100或更高的data.frame，我的问题是，是否可以加速＆＃39;我的功能可能是更优雅的编程。谢谢。

Answer 1

以及减少执行的测试次数或其他方式优化整个功能的运行，我们或许可以做到 assocstats更快。我们首先建立一个测试用例确定我们不会意外地发挥更快的功能。

x <- vcd::Arthritis$Improved
y <- vcd::Arthritis$Treatment
correct <- vcd::assocstats(table(x, y))$cramer
correct

## [1] 0.3942

is_ok <- function(x) stopifnot(all.equal(x, correct))

我们首先制作一个与assocstats非常接近的版本cramer1 <- function (x, y) { mat <- table(x, y) tab <- summary(MASS::loglm(~1 + 2, mat))$tests phi <- sqrt(tab[2, 1] / sum(mat)) cont <- sqrt(phi ^ 2 / (1 + phi ^ 2)) sqrt(phi ^ 2 / min(dim(mat) - 1)) } is_ok(cramer1(x, y)) 原始

loglm

这里最慢的操作是cramer2 <- function(x, y) { chi <- chisq.test(x, y, correct=FALSE)$statistic[[1]] ulength_x <- length(unique(x)) ulength_y <- length(unique(y)) sqrt(chi / (length(x) * (min(ulength_x, ulength_y) - 1))) } is_ok(cramer2(x, y))，所以在我们尝试之前要做得更快，值得寻找替代方法。一个小小的谷歌搜索a useful blog post。我们也尝试一下：

library(microbenchmark)

microbenchmark(
  cramer1(x, y),
  cramer2(x, y)
)

## Unit: microseconds
##           expr    min     lq median     uq  max neval
##  cramer1(x, y) 1080.0 1149.3 1182.0 1222.1 2598   100
##  cramer2(x, y)  800.7  850.6  881.9  934.6 1866   100

表现如何叠加：

cramer2()

chisq.test()更快。 chisq.test()可能是瓶颈，所以让我们看看我们是否可以通过减少更少的功能来提高功能： chisq_test <- function (x, y) { O <- table(x, y) n <- sum(O) E <- outer(rowSums(O), colSums(O), "*")/n sum((abs(O - E))^2 / E) }比计算测试统计数据做的更多，所以它是可能我们可以让它更快。几分钟的细心工作减少了功能：

cramer3()

然后，我们可以创建一个使用chisq.test()的新cramer3 <- function(x, y) { chi <- chisq_test(x, y) ulength_x <- length(unique(x)) ulength_y <- length(unique(y)) sqrt(chi / (length(x) * (min(ulength_x, ulength_y) - 1))) } is_ok(cramer3(x, y)) microbenchmark( cramer1(x, y), cramer2(x, y), cramer3(x, y) ) ## Unit: microseconds ## expr min lq median uq max neval ## cramer1(x, y) 1088.6 1138.9 1169.6 1221.5 2534 100 ## cramer2(x, y) 796.1 840.6 865.0 906.6 1893 100 ## cramer3(x, y) 334.6 358.7 373.5 390.4 1409 100。

chisq.test()

现在我们可以拥有自己的table()简单版本通过使用x的结果来计算出更快的速度 out y和cramer4 <- function(x, y) { O <- table(x, y) n <- length(x) E <- outer(rowSums(O), colSums(O), "*")/n chi <- sum((abs(O - E))^2 / E) sqrt(chi / (length(x) * (min(dim(O)) - 1))) } is_ok(cramer4(x, y)) microbenchmark( cramer1(x, y), cramer2(x, y), cramer3(x, y), cramer4(x, y) ) ## Unit: microseconds ## expr min lq median uq max neval ## cramer1(x, y) 1097.6 1145.8 1183.3 1233.3 2318 100 ## cramer2(x, y) 800.7 840.5 860.7 895.5 2079 100 ## cramer3(x, y) 334.4 353.1 365.7 384.1 1654 100 ## cramer4(x, y) 248.0 263.3 273.2 283.5 1342 100中的唯一元素数量：

tcrossprod()

不错 - 我们使用R代码的速度提高了4倍。从这里，你可以尝试通过以下方式获得更快的速度：

使用outer()代替table()
为此特殊（2d）案例制作更快版本的{{1}}
使用Rcpp从表格数据计算测试统计数据

Answer 2

您可以通过仅计算矩阵的一半来缩短计算时间：

get.V2 <-function(y){
  cb <- combn(1:ncol(y), 2, function(i)assocstats(table(y[, i[1]], y[, i[2]]))$cramer)
  m <- matrix(0, ncol(y), ncol(y))
  m[lower.tri(m)] <- cb
  diag(m) <- 1
  ## copy the lower.tri to upper.tri, suggested by @iacobus
  for (i in 1:nrow(m)) {
    m[i, ] <- m[, i]
  }
  return(m)
}

<小时/> 编辑：添加@iacobus建议填充矩阵的upper.tri并添加一点基准：

library("vcd")
library("qdapTools")
library("rbenchmark")

## suggested by @TylerRinker
get.V3 <- function(y)v_outer(y, function(i, j)assocstats(table(i, j))$cramer)

set.seed(1)
no.var<-10
y<-matrix(ncol=no.var,sample(1:5,100*no.var,TRUE))

benchmark(get.V(y), get.V2(y), get.V3(y), replications=10, order="relative")
#       test replications elapsed relative user.self sys.self user.child sys.child
#2 get.V2(y)           10   0.992    1.000     0.988    0.000          0         0
#1  get.V(y)           10   2.239    2.257     2.232    0.004          0         0
#3 get.V3(y)           10   2.495    2.515     2.484    0.004          0         0

Answer 3

你最好使用Tyler建议的外部矢量化版本。通过编写一个函数来计算Cramer的V，你仍然可以提高性能。assocstats函数在表上使用summary并计算很多你不想要的统计数据。如果您按照

的方式回复assocstats对用户定义函数的调用

cv <- function(x, y) {
    t <- table(x, y)
    chi <- chisq.test(t)$statistic
    cramer <- sqrt(chi / (NROW(x) * (min(dim(t)) - 1)))
    cramer
}

这个新功能仅通过计算Cramer的V，在assocstats所需时间的大约40％的时间内运行。您可以再次加速我将chisq.test减少到只计算卡方检验统计量的东西。

即使您只是调整循环索引值以实现对角线上的对称矩阵为1并且使用此cv函数而不是assocstats，您可以轻松地将其增加5倍性能。

编辑：根据要求，我用来获得4倍加速的完整代码是

cv <- function(x, y) {
  t <- table(x, y)
  chi <- suppressWarnings(chisq.test(t))$statistic
  cramer <- sqrt(chi / (NROW(x) * (min(dim(t)) - 1)))
  cramer
}

get.V3<-function(y, fill = TRUE){
  col.y<-ncol(y)
  V<-matrix(ncol=col.y,nrow=col.y)
  for(i in 1:(col.y - 1)){
    for(j in (i + 1):col.y){
      V[i,j]<-cv(y[,i],y[,j])
    }
  }
  diag(V) <- 1 
  if (fill) {
    for (i in 1:ncol(V)) {
      V[, i] <- V[i, ]
    }
  }
  V
}

它看起来与Hadley在下面的建议非常相似，尽管他在Cramer's V中的函数版本在correct = FALSE中使用了chisq.test。如果所有表都大于2x2，则correct上的设置无关紧要。对于2x2表，结果将根据参数而变化。最好按照他的示例并将其设置为correct = FALSE，以便无论表大小如何，所有内容都计算相同。

Answer 4

这使用outer的矢量化版本：

library(qdapTools)
y <- matrix(ncol=no.var,sample(1:5,100*no.var,TRUE))

get.V2<-function(x, y){
    assocstats(table(x, y))$cramer
}
v_outer(y, get.V2)

## > v_outer(y, get.V2)
##       V1    V2    V3    V4    V5
## V1 1.000 0.224 0.158 0.195 0.217
## V2 0.224 1.000 0.175 0.163 0.240
## V3 0.158 0.175 1.000 0.208 0.145
## V4 0.195 0.163 0.208 1.000 0.189
## V5 0.217 0.240 0.145 0.189 1.000

修改的

在1000个变量上，这些是系统时间：

泰勒：时差为38.79437分钟 sgibb：时差为19.54342分钟

显然，sgibb的方法更胜一筹。

是否有可能加快我创建相关矩阵的功能？

4 个答案: