是否有一个R函数将函数应用于每对列？
我经常需要对数据框/matrix中的每对列应用函数，并将结果以matrixforms返回。 现在我总是写一个循环来做到这一点。 例如，要创build一个包含相关p值的matrix，我写：
df <- data.frame(x=rnorm(100),y=rnorm(100),z=rnorm(100)) n <- ncol(df) foo <- matrix(0,n,n) for ( i in 1:n) { for (j in i:n) { foo[i,j] <- cor.test(df[,i],df[,j])$p.value } } foo[lower.tri(foo)] <- t(foo)[lower.tri(foo)] foo [,1] [,2] [,3] [1,] 0.0000000 0.7215071 0.5651266 [2,] 0.7215071 0.0000000 0.9019746 [3,] 0.5651266 0.9019746 0.0000000 哪个起作用，但是对于非常大的matrix非常缓慢。 我可以在R中为此写一个函数（不要因为假设上面的对称结果而把切割时间减半）：
Papply <- function(x,fun) { n <- ncol(x) foo <- matrix(0,n,n) for ( i in 1:n) { for (j in 1:n) { foo[i,j] <- fun(x[,i],x[,j]) } } return(foo) }
或者使用Rcpp的函数：
library("Rcpp") library("inline") src <- ' NumericMatrix x(xR); Function f(fun); NumericMatrix y(x.ncol(),x.ncol()); for (int i = 0; i < x.ncol(); i++) { for (int j = 0; j < x.ncol(); j++) { y(i,j) = as<double>(f(wrap(x(_,i)),wrap(x(_,j)))); } } return wrap(y); ' Papply2 <- cxxfunction(signature(xR="numeric",fun="function"),src,plugin="Rcpp")
但是，即使在一个非常小的100个variables的数据集上，两者都非常缓慢（我认为Rcpp函数会更快，但是我猜R和C ++之间的转换总是会受到影响）：
> system.time(Papply(matrix(rnorm(100*300),300,100),function(x,y)cor.test(x,y)$p.value)) user system elapsed 3.73 0.00 3.73 > system.time(Papply2(matrix(rnorm(100*300),300,100),function(x,y)cor.test(x,y)$p.value)) user system elapsed 3.71 0.02 3.75
所以我的问题是：
- 由于这些函数的简单性，我认为这已经在R的某个地方了。是否有一个应用程序或
plyr函数来做到这一点？ 我已经find它，但一直没能find它。 - 如果是这样，它是否更快？
这不会更快，但是你可以使用outer来简化代码。 它确实需要一个vector化的函数，所以在这里我使用了Vectorize来创build函数的vector化版本来获得两列之间的相关性。
df <- data.frame(x=rnorm(100),y=rnorm(100),z=rnorm(100)) n <- ncol(df) corpij <- function(i,j,data) {cor.test(data[,i],data[,j])$p.value} corp <- Vectorize(corpij, vectorize.args=list("i","j")) outer(1:n,1:n,corp,data=df)
我不确定这是否能够以适当的方式解决您的问题，但请看William Revelle的psych套餐。 corr.test返回具有相关系数，obs，t检验统计量和p值的matrix列表。 我知道我总是使用它（而AFAICS你也是一个心理学家，所以它也可以满足你的需求）。 编写循环并不是最优雅的方式。
library(psych) corr.test(mtcars) ( k <- corr.test(mtcars[1:5]) ) Call:corr.test(x = mtcars[1:5]) Correlation matrix mpg cyl disp hp drat mpg 1.00 -0.85 -0.85 -0.78 0.68 cyl -0.85 1.00 0.90 0.83 -0.70 disp -0.85 0.90 1.00 0.79 -0.71 hp -0.78 0.83 0.79 1.00 -0.45 drat 0.68 -0.70 -0.71 -0.45 1.00 Sample Size mpg cyl disp hp drat mpg 32 32 32 32 32 cyl 32 32 32 32 32 disp 32 32 32 32 32 hp 32 32 32 32 32 drat 32 32 32 32 32 Probability value mpg cyl disp hp drat mpg 0 0 0 0.00 0.00 cyl 0 0 0 0.00 0.00 disp 0 0 0 0.00 0.00 hp 0 0 0 0.00 0.01 drat 0 0 0 0.01 0.00 str(k) List of 5 $ r : num [1:5, 1:5] 1 -0.852 -0.848 -0.776 0.681 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... $ n : num [1:5, 1:5] 32 32 32 32 32 32 32 32 32 32 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... $ t : num [1:5, 1:5] Inf -8.92 -8.75 -6.74 5.1 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... $ p : num [1:5, 1:5] 0.00 6.11e-10 9.38e-10 1.79e-07 1.78e-05 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... .. ..$ : chr [1:5] "mpg" "cyl" "disp" "hp" ... $ Call: language corr.test(x = mtcars[1:5]) - attr(*, "class")= chr [1:2] "psych" "corr.test"
92％的时间花费在cor.test.default和它调用的例程上，所以它通过简单地重写Papply来获得更快的结果是Papply （除了只计算那些高于或低于对angular线的节省，假设你的函数是对称的在x和y ）。
> M <- matrix(rnorm(100*300),300,100) > Rprof(); junk <- Papply(M,function(x,y) cor.test( x, y)$p.value); Rprof(NULL) > summaryRprof() $by.self self.time self.pct total.time total.pct cor.test.default 4.36 29.54 13.56 91.87 # ... snip ...
你可以使用mapply ，但是正如其他答案所指出的那样，大部分时间都被cor.test使用， cor.test不太可能更快。
matrix(mapply(function(x,y) cor.test(df[,x],df[,y])$p.value,rep(1:3,3),sort(rep(1:3,3))),nrow=3,ncol=3)
你可以通过使用对称性假设和注意零对angular线来减less工作量
v <- mapply(function(x,y) cor.test(df[,x],df[,y])$p.value,rep(1:2,2:1),rev(rep(3:2,2:1))) m <- matrix(0,nrow=3,ncol=3) m[lower.tri(m)] <- v m[upper.tri(m)] <- v
