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 = '' x <- c(17.5,28.2,81.8,75.4,58,58,68.3,64.3,100.2,65.3,44.9,23.6,33.7,29.5,93.9,49.9,94.8,66.7,31.9,27.1,82.3,17.5,76.6,62.6,29.1,14.2,31.2,93.8,96.1,12.1,160.5,74.2,85.3,22.8,28.7,44.8,69,38,79.4,40.2,55,40.7,51.8,25.9,24.1,34.9,46.2,48.3,52.2,24.1,31.6,42.2,28.8,51.6,62.6,44.2,72.6,20,121.9,106.1,103.4,148.7,98.5,61.5,55.2,76,125.3,34.1,48.8,74.3,44.8,15,57.8,100.6,45.5,128.5,36.4,31.3,47.2,*,37.3,30.4,40.8,85.3,89.8,103.2,65.8,49.1,26.6,45.9,78,66.7,31.2,191.7,17.5,43.3,131.3,76.4,115.1,69.5,48.4,18.9,62.2,55.2,112.2,87.9,85.4,102.7,49.1,45.5,49.5,31.3,37.9,38.3,31.1,56.7,54.1,36.7,54.4,37.5,136.8,57.5,69.8,37,73.4,80.4,46.3,45.6,88.7,63.7,97.3,83.4,23.9,68.7,75.7,58,27.4,107.6,110.1,62.9,33.6,41.5,15.4,91.1,69,69.7,95.1,86.4,40.4,80,91.6,110,58.8,59.1,68.6,56.3,73,83,31.4,19,32.9,*,20.6,54.9,39.3,43.8,31,40.5,30.7,59.8,60.9,84,71.9,98.4,42.4,69.4,21,55.3,46.7,81.4,42.1,66.6,79,55.8,39.5,43.9,54.3,39.1,24.78,58.1,50.1,52,52.6,77.2,40.8,38.8,34.8,53.5,103,41.5,63.4,96.2,91.9,30.7,56,55.7,73.5,61.4,62.5,59.8,55.1,99,83.9,32.9,57,71.7,73.9,29.4,136.5,81.2,74,69,32.9,49.2,65.8,53.9,29,57,42,59.5,46.1,40.1,66.6,51.1,22.1,30.5,64.4,67.4,40.5,49.4,28.6,46.1,10,67.3,23.2,59.9,88.2,62.8,40.8,41,38.2,63.4,51.4,59.4,69.8,83.8,47.4,66.8,86.5,49.1,68.8,80.7,105.3,61.3,36.9,70.5,23.5,52.9,30.3,29.9,47.7,59.4,33.9,42.3,40.8,47,54.2,68.1,43.4,82.7,88.9,40.3,85.9,24.7,54.5,95.6,46.3,70.7,99.8,43.6,55.6,14.9,58,46.5,41.8,48,55.3,42.7,19.2,*,68.8,61.2,67.2,118.1,102.6,175.8,66.9,59.4,46.8,46.4,30.3,69.5,60.4,56.3,57,67.4,86.2,105.6,55.6,27.2,31.4,32.2,73.1,44.4,49,79.2,20.6,15.7,64.7,32.1,45.4,60.5,93.7,40,15,41.9,49.1,25.1,16.3,91.2,54.9,55.2,70.2,56,10.1,56.1,56.2,91.8,17.6,37.1,49.7,66.7,50.4,49.7,68,14.8,32.1,42.7,64.2,83,55.3,21.6,78.3,63.1,27.2,31.3,48.6,17.4,39.2,18,66.2,81.2,87.2,28.4,86.1,34.1,57,41.4,28.4,62.8,97,99.1,10.5,72.4,81.2,79.5,91.8,63.7,84.7,63.7,48.6,64.7,23.7,47,50.7,25.3,46.5,39.4,43.3,49,35.8,35,53.7,85.9,26.4,98,34.4,60,78.9,41.7,40.1,78.8,101.6,49.4,69.3,101.5,43.3,24.3,73.9,63.3,54.6,52.1,74.2,35.3,84.7,70.3,70.3,92.7,122.5,25.5,75,51.5,15.8,38.7,23.7,69.9,93.8,61.1,28.4,55.3,68.3,42.8,50.6,64.3,18.4,70.4,58.8,68,157.2,76.5,38.7,30.4,36.9,66.6,52.9,72.7,74.9,47.5,37,43.9,97.3,56.8,96.3,85,95,104.6,98.2,65.7,64.9,53.5,86,32.6,34.3,21.7,30.4,32.1) par5 = 'Yes' par4 = '0' par3 = '2' par2 = '-2' par1 = 'Full Box-Cox transform' par5 <- 'Yes' par4 <- '0' par3 <- '2' par2 <- '-2' par1 <- 'Full Box-Cox transform' #'GNU S' R Code compiled by R2WASP v. 1.2.327 (Thu, 22 Sep 2016 15:29:53 +0200) #Author: root #To cite this work: Wessa P., (2016), Box-Cox Normality Plot (v1.1.12) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_boxcoxnorm.wasp/ #Source of accompanying publication: Office for Research, Development, and Education # library(car) par2 <- abs(as.numeric(par2)*100) par3 <- as.numeric(par3)*100 if(par4=='') par4 <- 0 par4 <- as.numeric(par4) numlam <- par2 + par3 + 1 x <- x + par4 n <- length(x) c <- array(NA,dim=c(numlam)) l <- array(NA,dim=c(numlam)) mx <- -1 mxli <- -999 for (i in 1:numlam) { l[i] <- (i-par2-1)/100 if (l[i] != 0) { if (par1 == 'Full Box-Cox transform') x1 <- (x^l[i] - 1) / l[i] if (par1 == 'Simple Box-Cox transform') x1 <- x^l[i] } else { x1 <- log(x) } c[i] <- cor(qnorm(ppoints(x), mean=0, sd=1),sort(x1)) if (mx < c[i]) { mx <- c[i] mxli <- l[i] x1.best <- x1 } } print(c) print(mx) print(mxli) print(x1.best) if (mxli != 0) { if (par1 == 'Full Box-Cox transform') x1 <- (x^mxli - 1) / mxli if (par1 == 'Simple Box-Cox transform') x1 <- x^mxli } else { x1 <- log(x) } mypT <- powerTransform(x) summary(mypT) postscript(file="/home/pw/wessanet/rcomp/tmp/1xtb21586420324.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) plot(l,c,main='Box-Cox Normality Plot', xlab='Lambda',ylab='correlation') mtext(paste('Optimal Lambda =',mxli)) grid() dev.off() postscript(file="/home/pw/wessanet/rcomp/tmp/24nt01586420324.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) hist(x,main='Histogram of Original Data',xlab='X',ylab='frequency') grid() dev.off() postscript(file="/home/pw/wessanet/rcomp/tmp/3cmmh1586420324.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) hist(x1,main='Histogram of Transformed Data', xlab='X',ylab='frequency') grid() dev.off() postscript(file="/home/pw/wessanet/rcomp/tmp/4kqxe1586420324.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) qqPlot(x) grid() mtext('Original Data') dev.off() postscript(file="/home/pw/wessanet/rcomp/tmp/561f21586420324.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) qqPlot(x1) grid() mtext('Transformed Data') dev.off() a<-table.start() a<-table.row.start(a) a<-table.element(a,'Box-Cox Normality Plot',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'# observations x',header=TRUE) a<-table.element(a,n) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'maximum correlation',header=TRUE) a<-table.element(a,mx) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'optimal lambda',header=TRUE) a<-table.element(a,mxli) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'transformation formula',header=TRUE) if (par1 == 'Full Box-Cox transform') { a<-table.element(a,'for all lambda <> 0 : T(Y) = (Y^lambda - 1) / lambda') } else { a<-table.element(a,'for all lambda <> 0 : T(Y) = Y^lambda') } a<-table.row.end(a) if(mx<0) { a<-table.row.start(a) a<-table.element(a,'Warning: maximum correlation is negative! The Box-Cox transformation must not be used.',2) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/home/pw/wessanet/rcomp/tmp/6fy3d1586420324.tab") if(par5=='Yes') { a<-table.start() a<-table.row.start(a) a<-table.element(a,'Obs.',header=T) a<-table.element(a,'Original',header=T) a<-table.element(a,'Transformed',header=T) a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,i) a<-table.element(a,x[i]) a<-table.element(a,x1.best[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file="/home/pw/wessanet/rcomp/tmp/74d5t1586420324.tab") } a<-table.start() a<-table.row.start(a) a<-table.element(a,'Maximum Likelihood Estimation of Lambda',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,paste('
',RC.texteval('summary(mypT)'),'',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file="/home/pw/wessanet/rcomp/tmp/846fu1586420324.tab") try(system("convert /home/pw/wessanet/rcomp/tmp/1xtb21586420324.ps /home/pw/wessanet/rcomp/tmp/1xtb21586420324.png",intern=TRUE)) try(system("convert /home/pw/wessanet/rcomp/tmp/24nt01586420324.ps /home/pw/wessanet/rcomp/tmp/24nt01586420324.png",intern=TRUE)) try(system("convert /home/pw/wessanet/rcomp/tmp/3cmmh1586420324.ps /home/pw/wessanet/rcomp/tmp/3cmmh1586420324.png",intern=TRUE)) try(system("convert /home/pw/wessanet/rcomp/tmp/4kqxe1586420324.ps /home/pw/wessanet/rcomp/tmp/4kqxe1586420324.png",intern=TRUE)) try(system("convert /home/pw/wessanet/rcomp/tmp/561f21586420324.ps /home/pw/wessanet/rcomp/tmp/561f21586420324.png",intern=TRUE))