source('/home/pw/wessanet/cretab') RC.capture <- function (expression, collapse = NULL) { resultConn <- textConnection('RC.resultText', open = 'w', local=TRUE) sink(resultConn) on.exit(function() { sink() close(resultConn) }) expression on.exit(NULL) sink() close(resultConn) return(paste(c(RC.resultText, ''), collapse = collapse, sep = '')) } RC.texteval <- function (sourceText, collapse = NULL, echo = TRUE) { sourceConn <- textConnection(sourceText, open = 'r') on.exit(close(sourceConn)) result <- RC.capture(source(file = sourceConn, local = FALSE, echo = echo, print.eval = TRUE), collapse = collapse) on.exit(NULL) close(sourceConn) res <- '' for(i in 1:length(result)) { if (result[i]!='') res <- paste(res,result[i],' ',sep='') } return(res) } myrfcuid = '' y <- c(male 253.467,female 115.190) x <- c(18-24 80.847,25-34 147.964,35-44 73.732,45-54 28.296,55-64 11.118,65+ 6.502) ylab = 'y' xlab = 'x' main = 'Scatterplot and histograms' #'GNU S' R Code compiled by R2WASP v. 1.2.327 (Sun, 30 Jul 2017 18:15:01 +0200) #Author: root #To cite this work: Wessa P., (2017), Pearson Correlation (v1.0.13) in Free Statistics Software (v$_version), Office for Research Development and Education, URL https://www.wessa.net/rwasp_correlation.wasp/ #Source of accompanying publication: Office for Research, Development, and Education # library(psychometric) x <- x[!is.na(y)] y <- y[!is.na(y)] y <- y[!is.na(x)] x <- x[!is.na(x)] postscript(file="/home/pw/wessanet/rcomp/tmp/1h3vx1589634590.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) histx <- hist(x, plot=FALSE) histy <- hist(y, plot=FALSE) maxcounts <- max(c(histx$counts, histx$counts)) xrange <- c(min(x),max(x)) yrange <- c(min(y),max(y)) nf <- layout(matrix(c(2,0,1,3),2,2,byrow=TRUE), c(3,1), c(1,3), TRUE) par(mar=c(4,4,1,1)) plot(x, y, xlim=xrange, ylim=yrange, xlab=xlab, ylab=ylab, sub=main) par(mar=c(0,4,1,1)) barplot(histx$counts, axes=FALSE, ylim=c(0, maxcounts), space=0) par(mar=c(4,0,1,1)) barplot(histy$counts, axes=FALSE, xlim=c(0, maxcounts), space=0, horiz=TRUE) dev.off() lx = length(x) makebiased = (lx-1)/lx varx = var(x)*makebiased vary = var(y)*makebiased corxy <- cor.test(x,y,method='pearson', na.rm = T) cxy <- as.matrix(corxy$estimate)[1,1] a<-table.start() a<-table.row.start(a) a<-table.element(a,'Pearson Product Moment Correlation - Ungrouped Data',3,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Statistic',1,TRUE) a<-table.element(a,'Variable X',1,TRUE) a<-table.element(a,'Variable Y',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Mean',header=TRUE) a<-table.element(a,mean(x)) a<-table.element(a,mean(y)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Biased Variance',header=TRUE) a<-table.element(a,varx) a<-table.element(a,vary) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Biased Standard Deviation',header=TRUE) a<-table.element(a,sqrt(varx)) a<-table.element(a,sqrt(vary)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Covariance',header=TRUE) a<-table.element(a,cov(x,y),2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Correlation',header=TRUE) a<-table.element(a,cxy,2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Determination',header=TRUE) a<-table.element(a,cxy*cxy,2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'T-Test',header=TRUE) a<-table.element(a,as.matrix(corxy$statistic)[1,1],2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'p-value (2 sided)',header=TRUE) a<-table.element(a,(p2 <- as.matrix(corxy$p.value)[1,1]),2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'p-value (1 sided)',header=TRUE) a<-table.element(a,p2/2,2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'95% CI of Correlation',header=TRUE) a<-table.element(a,paste('[',CIr(r=cxy, n = lx, level = .95)[1],', ', CIr(r=cxy, n = lx, level = .95)[2],']',sep=''),2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Degrees of Freedom',header=TRUE) a<-table.element(a,lx-2,2) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Number of Observations',header=TRUE) a<-table.element(a,lx,2) a<-table.row.end(a) a<-table.end(a) table.save(a,file="/home/pw/wessanet/rcomp/tmp/2cebx1589634590.tab") library(moments) library(nortest) jarque.x <- jarque.test(x) jarque.y <- jarque.test(y) if(lx>7) { ad.x <- ad.test(x) ad.y <- ad.test(y) } a<-table.start() a<-table.row.start(a) a<-table.element(a,'Normality Tests',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,paste('
',RC.texteval('jarque.x'),'',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,paste('
',RC.texteval('jarque.y'),'',sep='')) a<-table.row.end(a) if(lx>7) { a<-table.row.start(a) a<-table.element(a,paste('
',RC.texteval('ad.x'),'',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,paste('
',RC.texteval('ad.y'),'',sep='')) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/home/pw/wessanet/rcomp/tmp/3xr1x1589634590.tab") library(car) postscript(file="/home/pw/wessanet/rcomp/tmp/46bkj1589634590.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) qqPlot(x,main='QQplot of variable x') dev.off() postscript(file="/home/pw/wessanet/rcomp/tmp/5ti0n1589634590.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) qqPlot(y,main='QQplot of variable y') dev.off() try(system("convert /home/pw/wessanet/rcomp/tmp/1h3vx1589634590.ps /home/pw/wessanet/rcomp/tmp/1h3vx1589634590.png",intern=TRUE)) try(system("convert /home/pw/wessanet/rcomp/tmp/46bkj1589634590.ps /home/pw/wessanet/rcomp/tmp/46bkj1589634590.png",intern=TRUE)) try(system("convert /home/pw/wessanet/rcomp/tmp/5ti0n1589634590.ps /home/pw/wessanet/rcomp/tmp/5ti0n1589634590.png",intern=TRUE))