Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
74 71 69 67 73 74 71 69 67 73 74 71 69 67 73 74 71 69 67 73 74 71 69 67 73 74 71 69 67 73 75 72 75 69 73 77 72 77 72 74 78 73 79 72 75 79 77 79 73 77 79 77 81 73 77 80 78 81 73 77 80 78 83 73 78 81 79 83 75 79 81 79 83 77 80 82 79 83 78 81 82 80 84 79 81 83 80 84 80 82 83 80 84 80 82 84 80 84 81 82 85 81 84 81 82 85 81 84 82 82 85 81 85 83 82 85 82 85 83 83 86 82 85 83 83 86 82 86 84 83 86 82 86 84 83 87 82 86 84 83 88 82 86 84 83 88 84 86 84 84 88 84 86 84 84 88 85 86 84 84 88 86 87 84 84 88 86 87 85 84 88 86 87 86 85 89 86 87 86 86 89 86 87 87 86 89 86 87 87 86 89 86 88 87 86 90 86 88 87 87 90 87 88 88 88 91 88 88 88 88 91 88 88 88 88 91 88 88 89 89 91 88 88 89 89 91 89 88 89 89 91 89 88 89 89 91 89 88 89 89 91 90 89 89 89 91 90 89 89 90 92 90 90 90 90 92 91 90 90 90 92 91 90 90 90 93 91 91 90 90 93 91 91 90 91 94 91 91 90 91 94 92 92 90 91 94 92 92 91 92 94 92 92 91 92 95 92 92 91 92 95 92 93 92 92 95 92 93 92 92 95 92 93 94 92 96 92 93 94 92 96 93 93 94 93 97 94 94 94 93 97 94 94 94 93 97 95 94 94 93 97 95 94 95 93 97 95 95 95 93 98 95 95 96 94 98 95 95 96 94 98 96 95 96 94 98 96 95 96 95 98 96 96 96 95 98 97 97 97 96 98 97 97 97 96 98 97 99 98 96 100 98 100 98 97 100 98 101 98 97 100 99 101 100 97 102 100 101 100 98 102 100 102 101 98 102 100 102 102 98 102 102 102 103 98 102 103 102 104 99 103 103 103 105 99 103 103 103 105 100 104 104 103 105 100 104 105 104 105 100 106 105 104 105 100 106 105 105 106 101 106 105 105 106 102 107 105 105 107 104 108 108 105 107 104 112 109 105 107 105 112 111 105 110 107 113 112 108 110 107 114 112 113 111 107 114 112 113 111 107 114 112 113 111 107 114 112 113 111 107 114 112 113 111 107 114 112 113 111 NA
Names of X columns:
WJ10AFS WJ10AVA WJ10ARD WJ10AMA WJ10AKN
Type of Correlation
pearson
spearman
kendall
Chart options
Title:
R Code
panel.tau <- function(x, y, digits=2, prefix='', cex.cor) { usr <- par('usr'); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) rr <- cor.test(x, y, method=par1) r <- round(rr$p.value,2) txt <- format(c(r, 0.123456789), digits=digits)[1] txt <- paste(prefix, txt, sep='') if(missing(cex.cor)) cex <- 0.5/strwidth(txt) text(0.5, 0.5, txt, cex = cex) } panel.hist <- function(x, ...) { usr <- par('usr'); on.exit(par(usr)) par(usr = c(usr[1:2], 0, 1.5) ) h <- hist(x, plot = FALSE) breaks <- h$breaks; nB <- length(breaks) y <- h$counts; y <- y/max(y) rect(breaks[-nB], 0, breaks[-1], y, col='grey', ...) } bitmap(file='test1.png') pairs(t(y),diag.panel=panel.hist, upper.panel=panel.smooth, lower.panel=panel.tau, main=main) dev.off() load(file='createtable') n <- length(y[,1]) n a<-table.start() a<-table.row.start(a) a<-table.element(a,paste('Correlations for all pairs of data series (method=',par1,')',sep=''),n+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,' ',header=TRUE) for (i in 1:n) { a<-table.element(a,dimnames(t(x))[[2]][i],header=TRUE) } a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,dimnames(t(x))[[2]][i],header=TRUE) for (j in 1:n) { r <- cor.test(y[i,],y[j,],method=par1) a<-table.element(a,round(r$estimate,3)) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable.tab') ncorrs <- (n*n -n)/2 mycorrs <- array(0, dim=c(10,3)) a<-table.start() a<-table.row.start(a) a<-table.element(a,'Correlations for all pairs of data series with p-values',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'pair',1,TRUE) a<-table.element(a,'Pearson r',1,TRUE) a<-table.element(a,'Spearman rho',1,TRUE) a<-table.element(a,'Kendall tau',1,TRUE) a<-table.row.end(a) cor.test(y[1,],y[2,],method=par1) for (i in 1:(n-1)) { for (j in (i+1):n) { a<-table.row.start(a) dum <- paste(dimnames(t(x))[[2]][i],';',dimnames(t(x))[[2]][j],sep='') a<-table.element(a,dum,header=TRUE) rp <- cor.test(y[i,],y[j,],method='pearson') a<-table.element(a,round(rp$estimate,4)) rs <- cor.test(y[i,],y[j,],method='spearman') a<-table.element(a,round(rs$estimate,4)) rk <- cor.test(y[i,],y[j,],method='kendall') a<-table.element(a,round(rk$estimate,4)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'p-value',header=T) a<-table.element(a,paste('(',round(rp$p.value,4),')',sep='')) a<-table.element(a,paste('(',round(rs$p.value,4),')',sep='')) a<-table.element(a,paste('(',round(rk$p.value,4),')',sep='')) a<-table.row.end(a) for (iii in 1:10) { iiid100 <- iii / 100 if (rp$p.value < iiid100) mycorrs[iii, 1] = mycorrs[iii, 1] + 1 if (rs$p.value < iiid100) mycorrs[iii, 2] = mycorrs[iii, 2] + 1 if (rk$p.value < iiid100) mycorrs[iii, 3] = mycorrs[iii, 3] + 1 } } } a<-table.end(a) table.save(a,file='mytable1.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Meta Analysis of Correlation Tests',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Number of significant by total number of Correlations',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Type I error',1,TRUE) a<-table.element(a,'Pearson r',1,TRUE) a<-table.element(a,'Spearman rho',1,TRUE) a<-table.element(a,'Kendall tau',1,TRUE) a<-table.row.end(a) for (iii in 1:10) { iiid100 <- iii / 100 a<-table.row.start(a) a<-table.element(a,round(iiid100,2),header=T) a<-table.element(a,round(mycorrs[iii,1]/ncorrs,2)) a<-table.element(a,round(mycorrs[iii,2]/ncorrs,2)) a<-table.element(a,round(mycorrs[iii,3]/ncorrs,2)) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable2.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation