Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
21 7.5 26 2.5 22 6 22 6.5 18 1 23 1 12 5.5 20 8.5 22 6.5 21 4.5 19 2 22 5 15 0.5 20 5 19 5 18 2.5 15 5 20 5.5 21 3.5 21 3 15 4 16 0.5 23 6.5 21 4.5 18 7.5 25 5.5 9 4 30 7.5 20 7 23 4 16 5.5 16 2.5 19 5.5 25 0.5 25 3.5 18 2.5 23 4.5 21 4.5 10 4.5 14 6 22 2.5 26 5 23 0 23 5 24 6.5 24 5 18 6 23 4.5 15 5.5 19 1 16 7.5 25 6 23 5 17 1 19 5 21 6.5 18 7 27 4.5 21 0 13 8.5 8 3.5 29 7.5 28 3.5 23 6 21 1.5 19 9 19 3.5 20 3.5 18 4 19 6.5 17 7.5 19 6 25 5 19 5.5 22 3.5 23 7.5 26 1 14 6.5 28 NA 16 6.5 24 6.5 20 7 12 3.5 24 1.5 22 4 12 7.5 22 4.5 20 0 10 3.5 23 5.5 17 5 22 4.5 24 2.5 18 7.5 21 7 20 0 20 4.5 22 3 19 1.5 20 3.5 26 2.5 23 5.5 24 8 21 1 21 5 19 4.5 8 3 17 3 20 8 11 2.5 8 7 15 0 18 1 18 3.5 19 5.5 19 5.5 23 0.5 22 7.5 21 9 25 9.5 30 8.5 17 7 27 8 23 10 23 7 18 8.5 18 9 23 9.5 19 4 15 6 20 8 16 5.5 24 9.5 25 7.5 25 7 19 7.5 19 8 16 7 19 7 19 6 23 10 21 2.5 22 9 19 8 20 6 20 8.5 3 6 23 9 14 8 23 8 20 9 15 5.5 13 5 16 7 7 5.5 24 9 17 2 24 8.5 24 9 19 8.5 25 9 20 7.5 28 10 23 9 27 7.5 18 6 28 10.5 21 8.5 19 8 23 10 27 10.5 22 6.5 28 9.5 25 8.5 21 7.5 22 5 28 8 20 10 29 7 25 7.5 25 7.5 20 9.5 20 6 16 10 20 7 20 3 23 6 18 7 25 10 18 7 19 3.5 25 8 25 10 25 5.5 24 6 19 6.5 26 6.5 10 8.5 17 4 13 9.5 17 8 30 8.5 25 5.5 4 7 16 9 21 8 23 10 22 8 17 6 20 8 20 5 22 9 16 4.5 23 8.5 16 7 0 9.5 18 8.5 25 7.5 23 7.5 12 5 18 7 24 8 11 5.5 18 8.5 14 7.5 23 9.5 24 7 29 8 18 8.5 15 3.5 29 6.5 16 6.5 19 10.5 22 8.5 16 8 23 10 23 10 19 9.5 4 9 20 10 24 7.5 20 4.5 4 4.5 24 0.5 22 6.5 16 4.5 3 5.5 15 5 24 6 17 4 20 8 27 10.5 23 8.5 26 6.5 23 8 17 8.5 20 5.5 22 7 19 5 24 3.5 19 5 23 9 15 8.5 27 5 26 9.5 22 3 22 1.5 18 6 15 0.5 22 6.5 27 7.5 10 4.5 20 8 17 9 23 7.5 19 8.5 13 7 27 9.5 23 6.5 16 9.5 25 6 2 8 26 9.5 20 8 23 8 22 9 24 5
Names of X columns:
Num Ex
Type of Correlation
14
pearson
spearman
kendall
Chart options
Title:
R Code
par1 <- 'kendall' 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