R version 2.6.0 (2007-10-03)
Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> y <- c(93.9,89.8,93.4,101.5,110.4,105.9,108.4,113.9,86.1,69.4,101.2,100.5,98.0,106.6,90.1,96.9,125.9,112.0,100.0,123.9,79.8,83.4,113.6,112.9,104.0,109.9,99.0,106.3,128.9,111.1,102.9,130.0,87.0,87.5,117.6,103.4,110.8,112.6,102.5,112.4,135.6,105.1,127.7,137.0,91.0,90.5,122.4,123.3,124.3,120.0,118.1,119.0,142.7,123.6,129.6,151.6,110.4,99.3,129.1,134.1)
> x <- c(106.9,107.1,99.3,99.2,108.3,105.6,99.5,107.4,93.1,88.1,110.7,113.1,99.6,93.6,98.6,99.6,114.3,107.8,101.2,112.5,100.5,93.9,116.2,112.0,106.4,95.7,96.0,95.8,103.0,102.2,98.4,111.4,86.6,91.3,107.9,101.8,104.4,93.4,100.1,98.5,112.9,101.4,107.1,110.8,90.3,95.5,111.4,113.0,107.5,95.9,106.3,105.2,117.2,106.9,108.2,113.0,97.2,100.2,109.7,119.1)
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: Wessa P., (2007), Box-Cox Linearity Plot (v1.0.3) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_boxcoxlin.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description
> n <- length(x)
> c <- array(NA,dim=c(401))
> l <- array(NA,dim=c(401))
> mx <- 0
> mxli <- -999
> for (i in 1:401)
+ {
+ l[i] <- (i-201)/100
+ if (l[i] != 0)
+ {
+ x1 <- (x^l[i] - 1) / l[i]
+ } else {
+ x1 <- log(x)
+ }
+ c[i] <- cor(x1,y)
+ if (mx < abs(c[i]))
+ {
+ mx <- abs(c[i])
+ mxli <- l[i]
+ }
+ }
> c
  [1] 0.7048738 0.7049119 0.7049499 0.7049878 0.7050256 0.7050632 0.7051008
  [8] 0.7051382 0.7051755 0.7052127 0.7052498 0.7052868 0.7053236 0.7053604
 [15] 0.7053970 0.7054336 0.7054700 0.7055063 0.7055425 0.7055786 0.7056145
 [22] 0.7056504 0.7056861 0.7057218 0.7057573 0.7057927 0.7058280 0.7058632
 [29] 0.7058983 0.7059332 0.7059681 0.7060028 0.7060374 0.7060719 0.7061063
 [36] 0.7061406 0.7061748 0.7062088 0.7062428 0.7062766 0.7063104 0.7063440
 [43] 0.7063775 0.7064109 0.7064441 0.7064773 0.7065103 0.7065433 0.7065761
 [50] 0.7066088 0.7066414 0.7066739 0.7067063 0.7067386 0.7067707 0.7068028
 [57] 0.7068347 0.7068665 0.7068982 0.7069298 0.7069613 0.7069927 0.7070239
 [64] 0.7070551 0.7070861 0.7071170 0.7071478 0.7071785 0.7072091 0.7072396
 [71] 0.7072699 0.7073002 0.7073303 0.7073603 0.7073902 0.7074200 0.7074497
 [78] 0.7074793 0.7075087 0.7075381 0.7075673 0.7075965 0.7076255 0.7076544
 [85] 0.7076832 0.7077118 0.7077404 0.7077689 0.7077972 0.7078254 0.7078535
 [92] 0.7078816 0.7079094 0.7079372 0.7079649 0.7079925 0.7080199 0.7080472
 [99] 0.7080745 0.7081016 0.7081286 0.7081554 0.7081822 0.7082089 0.7082354
[106] 0.7082619 0.7082882 0.7083144 0.7083405 0.7083665 0.7083924 0.7084181
[113] 0.7084438 0.7084693 0.7084948 0.7085201 0.7085453 0.7085704 0.7085954
[120] 0.7086203 0.7086450 0.7086697 0.7086942 0.7087186 0.7087429 0.7087671
[127] 0.7087912 0.7088152 0.7088391 0.7088628 0.7088865 0.7089100 0.7089334
[134] 0.7089567 0.7089799 0.7090030 0.7090260 0.7090489 0.7090716 0.7090943
[141] 0.7091168 0.7091392 0.7091615 0.7091837 0.7092058 0.7092278 0.7092496
[148] 0.7092714 0.7092930 0.7093146 0.7093360 0.7093573 0.7093785 0.7093996
[155] 0.7094205 0.7094414 0.7094621 0.7094828 0.7095033 0.7095237 0.7095440
[162] 0.7095642 0.7095843 0.7096043 0.7096241 0.7096439 0.7096635 0.7096830
[169] 0.7097025 0.7097218 0.7097410 0.7097600 0.7097790 0.7097979 0.7098166
[176] 0.7098353 0.7098538 0.7098722 0.7098905 0.7099087 0.7099268 0.7099448
[183] 0.7099627 0.7099804 0.7099981 0.7100156 0.7100330 0.7100503 0.7100675
[190] 0.7100846 0.7101016 0.7101185 0.7101352 0.7101519 0.7101684 0.7101848
[197] 0.7102012 0.7102174 0.7102335 0.7102495 0.7102653 0.7102811 0.7102968
[204] 0.7103123 0.7103277 0.7103431 0.7103583 0.7103734 0.7103884 0.7104033
[211] 0.7104180 0.7104327 0.7104473 0.7104617 0.7104761 0.7104903 0.7105044
[218] 0.7105184 0.7105323 0.7105461 0.7105598 0.7105733 0.7105868 0.7106001
[225] 0.7106134 0.7106265 0.7106395 0.7106524 0.7106652 0.7106779 0.7106905
[232] 0.7107030 0.7107153 0.7107276 0.7107397 0.7107517 0.7107637 0.7107755
[239] 0.7107872 0.7107988 0.7108103 0.7108216 0.7108329 0.7108441 0.7108551
[246] 0.7108661 0.7108769 0.7108876 0.7108982 0.7109087 0.7109191 0.7109294
[253] 0.7109396 0.7109497 0.7109596 0.7109695 0.7109792 0.7109888 0.7109984
[260] 0.7110078 0.7110171 0.7110263 0.7110354 0.7110444 0.7110532 0.7110620
[267] 0.7110707 0.7110792 0.7110876 0.7110960 0.7111042 0.7111123 0.7111203
[274] 0.7111282 0.7111360 0.7111437 0.7111512 0.7111587 0.7111661 0.7111733
[281] 0.7111804 0.7111875 0.7111944 0.7112012 0.7112079 0.7112145 0.7112210
[288] 0.7112274 0.7112337 0.7112398 0.7112459 0.7112519 0.7112577 0.7112634
[295] 0.7112691 0.7112746 0.7112800 0.7112853 0.7112905 0.7112956 0.7113006
[302] 0.7113055 0.7113102 0.7113149 0.7113194 0.7113239 0.7113282 0.7113325
[309] 0.7113366 0.7113406 0.7113445 0.7113483 0.7113520 0.7113556 0.7113591
[316] 0.7113625 0.7113658 0.7113689 0.7113720 0.7113749 0.7113778 0.7113805
[323] 0.7113831 0.7113857 0.7113881 0.7113904 0.7113926 0.7113947 0.7113967
[330] 0.7113986 0.7114003 0.7114020 0.7114036 0.7114050 0.7114064 0.7114076
[337] 0.7114088 0.7114098 0.7114107 0.7114115 0.7114123 0.7114129 0.7114134
[344] 0.7114138 0.7114141 0.7114143 0.7114143 0.7114143 0.7114142 0.7114139
[351] 0.7114136 0.7114132 0.7114126 0.7114119 0.7114112 0.7114103 0.7114093
[358] 0.7114082 0.7114071 0.7114058 0.7114044 0.7114029 0.7114013 0.7113996
[365] 0.7113977 0.7113958 0.7113938 0.7113917 0.7113894 0.7113871 0.7113846
[372] 0.7113821 0.7113794 0.7113767 0.7113738 0.7113708 0.7113677 0.7113646
[379] 0.7113613 0.7113579 0.7113544 0.7113508 0.7113471 0.7113433 0.7113394
[386] 0.7113354 0.7113313 0.7113270 0.7113227 0.7113183 0.7113137 0.7113091
[393] 0.7113044 0.7112995 0.7112946 0.7112895 0.7112843 0.7112791 0.7112737
[400] 0.7112682 0.7112627
> mx
[1] 0.7114143
> mxli
[1] 1.46
> if (mxli != 0)
+ {
+ x1 <- (x^mxli - 1) / mxli
+ } else {
+ x1 <- log(x)
+ }
> r<-lm(y~x)
> se <- sqrt(var(r$residuals))
> r1 <- lm(y~x1)
> se1 <- sqrt(var(r1$residuals))
> postscript(file="/var/www/html/rcomp/tmp/1y2mf1197801470.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
> plot(l,c,main='Box-Cox Linearity Plot',xlab='Lambda',ylab='correlation')
> grid()
> dev.off()
null device 
          1 
> postscript(file="/var/www/html/rcomp/tmp/2hy761197801470.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
> plot(x,y,main='Linear Fit of Original Data',xlab='x',ylab='y')
> abline(r)
> grid()
> mtext(paste('Residual Standard Deviation = ',se))
> dev.off()
null device 
          1 
> postscript(file="/var/www/html/rcomp/tmp/3ovq61197801470.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
> plot(x1,y,main='Linear Fit of Transformed Data',xlab='x',ylab='y')
> abline(r1)
> grid()
> mtext(paste('Residual Standard Deviation = ',se1))
> dev.off()
null device 
          1 
> load(file='/var/www/html/rcomp/createtable')
> a<-table.start()
> a<-table.row.start(a)
> a<-table.element(a,'Box-Cox Linearity 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(x)',header=TRUE)
> a<-table.element(a,mxli)
> a<-table.row.end(a)
> a<-table.row.start(a)
> a<-table.element(a,'Residual SD (orginial)',header=TRUE)
> a<-table.element(a,se)
> a<-table.row.end(a)
> a<-table.row.start(a)
> a<-table.element(a,'Residual SD (transformed)',header=TRUE)
> a<-table.element(a,se1)
> a<-table.row.end(a)
> a<-table.end(a)
> table.save(a,file="/var/www/html/rcomp/tmp/4pki51197801470.tab") 
> 
> system("convert tmp/1y2mf1197801470.ps tmp/1y2mf1197801470.png")
> system("convert tmp/2hy761197801470.ps tmp/2hy761197801470.png")
> system("convert tmp/3ovq61197801470.ps tmp/3ovq61197801470.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.013   0.501   1.175