Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
57000 27000 144 40200 18750 36 21450 12000 381 21900 13200 190 45000 21000 138 32100 13500 67 36000 18750 114 21900 9750 0 27900 12750 115 24000 13500 244 30300 16500 143 28350 12000 26 27750 14250 34 35100 16800 137 27300 13500 66 40800 15000 24 46000 14250 48 103750 27510 70 42300 14250 103 26250 11550 48 38850 15000 17 21750 12750 315 24000 11100 75 16950 9000 124 21150 9000 171 31050 12600 14 60375 27480 96 32550 14250 43 135000 79980 199 31200 14250 54 36150 14250 83 110625 45000 120 42000 15000 68 92000 39990 175 81250 30000 18 31350 11250 52 29100 13500 113 31350 15000 49 36000 15000 46 19200 9000 23 23550 11550 52 35100 16500 90 23250 14250 46 29250 14250 50 30750 13500 307 22350 12750 165 30000 16500 228 30750 14100 240 34800 16500 93 60000 23730 59 35550 15000 48 45150 15000 40 73750 26250 56 25050 13500 444 27000 15000 120 26850 13500 5 33900 15750 78 26400 13500 3 28050 14250 36 30900 15000 102 22500 9750 36 48000 21750 22 55000 26250 32 53125 21000 48 21900 14550 41 78125 30000 7 46000 21240 35 45250 21480 36 56550 25000 34 41100 20250 27 82500 34980 207 54000 18000 11 26400 10500 0 33900 19500 192 24150 11550 0 29250 11550 11 27600 11400 6 22950 10500 10 34800 14550 8 51000 18000 22 24300 10950 5 24750 14250 193 22950 11250 0 25050 10950 8 25950 17100 42 31650 15750 64 24150 14100 130 72500 28740 10 68750 27480 8 16200 9750 0 20100 11250 24 24000 10950 6 25950 10950 0 24600 10050 44 28500 10500 6 30750 15000 432 40200 19500 168 30000 15000 144 22050 10950 5 78250 27480 47 60625 22500 44 39900 15750 59 97000 35010 68 27450 15750 48 31650 13500 18 91250 29490 23 25200 14400 83 21000 11550 108 30450 15000 49 28350 18000 151 30750 9000 314 30750 15000 240 54875 27480 68 37800 16500 60 33450 14100 85 30300 16500 16 31500 18750 205 31650 14250 48 25200 14100 55
Names of X columns:
Salary Salbegin Prevexp
Type of Correlation
pearson
pearson
spearman
kendall
Chart options
Title:
R Code
par1 <- 'pearson' 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', ...) } x <- na.omit(x) y <- t(na.omit(t(y))) 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]) print(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