क्या कोई आर फ़ंक्शन है जो कॉलम की प्रत्येक जोड़ी पर फ़ंक्शन लागू करता है?

Question

मुझे अक्सर डेटाफ्रेम/मैट्रिक्स में कॉलम की प्रत्येक जोड़ी में फ़ंक्शन लागू करने और परिणामों को मैट्रिक्स में वापस करने की आवश्यकता होती है। अब मैं हमेशा ऐसा करने के लिए एक लूप लिखता हूं।

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 

जो काम करता है, लेकिन बहुत बड़ी मैट्रिक्स के लिए काफी धीमी है: उदाहरण के लिए, एक मैट्रिक्स सहसंबंध मैं लिखने के पी मूल्यों से युक्त बनाने के लिए।

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 चर का एक बहुत छोटा सा डेटासेट पर धीमी गति से (मैंने सोचा था कि Rcpp समारोह तेजी से होगा, लेकिन मैं आर और सी के बीच रूपांतरण लगता ++ हर समय अपने टोल लेता है):

> 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 

तो मेरे सवाल है:

1. इन कार्यों की सादगी के कारण मुझे लगता है यह पहले से ही आर में कहीं है वहाँ एक को लागू करने या plyr समारोह है कि यह करता है? मैंने इसकी तलाश की है लेकिन इसे ढूंढने में सक्षम नहीं है।
2. यदि हां, तो क्या यह तेज़ है?

Answer 1

यह तेज़ नहीं होगा, लेकिन आप कोड को सरल बनाने के लिए outer का उपयोग कर सकते हैं। इसे एक वेक्टरीकृत फ़ंक्शन की आवश्यकता होती है, इसलिए यहां मैंने दो कॉलम के बीच सहसंबंध प्राप्त करने के लिए फ़ंक्शन का वेक्टरिज्ड संस्करण बनाने के लिए Vectorize का उपयोग किया है। इसकी बहुत तेजी से समय की सबसे cor.test द्वारा किया जा रहा है के रूप में होने की संभावना नहीं

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) 

Answer 2

मुझे यकीन नहीं है कि यह आपकी समस्या को उचित तरीके से संबोधित करता है, लेकिन विलियम रीवेल के psych पैकेज पर एक नज़र डालें। corr.test सहसंबंध कोफ्स, # ओब्स, टी-टेस्ट आंकड़े, और पी-वैल्यू के साथ मैट्रिक्स की सूची लौटाता है। मुझे पता है कि मैं इसे हर समय उपयोग करता हूं (और 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" 

Answer 3

समय की

92% cor.test.default में खर्च किया जा रहा है और यह बस केवल उन्हीं के ऊपर या विकर्ण यह सोचते हैं कि नीचे की गणना से Papply (बचत के अलावा अन्य दोबारा लिख ​​कर तेजी से परिणाम प्राप्त करने की कोशिश कर इसलिए इसकी निराशाजनक कॉल दिनचर्या अपने समारोह 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 ... 

Answer 4

आप mapply उपयोग कर सकते हैं, लेकिन जैसा कि अन्य उत्तर राज्य।

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) 

आप, समरूपता धारणा का उपयोग करने और शून्य विकर्ण टिप्पण द्वारा काम mapply करता है की मात्रा को कम कर सकता है जैसे

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