R version 2.7.2 (2008-08-25)
Copyright (C) 2008 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(4.77,4.75,4.91,4.68,4.71,4.61,4.36,4.3,4.54,4.71,4.57,4.63,4.57,4.33,4.14,4.08,3.98,3.89,3.82,3.74,3.67,3.61,3.51,3.36)
> x <- c(4.56,4.41,4.33,4.2,4.25,4.25,4.19,4.17,4.21,4.21,4.17,4.16,4.19,4.08,4.06,3.98,3.82,3.82,3.72,3.56,3.57,3.49,3.32,3.23)
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description (don't use hard returns!)
> 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.9445251 0.9446088 0.9446923 0.9447756 0.9448587 0.9449417 0.9450244
  [8] 0.9451069 0.9451893 0.9452714 0.9453534 0.9454352 0.9455167 0.9455981
 [15] 0.9456793 0.9457603 0.9458411 0.9459217 0.9460021 0.9460823 0.9461623
 [22] 0.9462422 0.9463218 0.9464012 0.9464805 0.9465595 0.9466384 0.9467170
 [29] 0.9467955 0.9468737 0.9469518 0.9470297 0.9471073 0.9471848 0.9472621
 [36] 0.9473391 0.9474160 0.9474927 0.9475692 0.9476455 0.9477216 0.9477975
 [43] 0.9478731 0.9479486 0.9480239 0.9480990 0.9481739 0.9482486 0.9483231
 [50] 0.9483974 0.9484715 0.9485454 0.9486191 0.9486926 0.9487659 0.9488390
 [57] 0.9489119 0.9489846 0.9490571 0.9491294 0.9492015 0.9492734 0.9493451
 [64] 0.9494165 0.9494878 0.9495589 0.9496298 0.9497005 0.9497709 0.9498412
 [71] 0.9499113 0.9499812 0.9500508 0.9501203 0.9501895 0.9502586 0.9503275
 [78] 0.9503961 0.9504645 0.9505328 0.9506008 0.9506687 0.9507363 0.9508037
 [85] 0.9508709 0.9509379 0.9510047 0.9510713 0.9511377 0.9512039 0.9512699
 [92] 0.9513357 0.9514013 0.9514666 0.9515318 0.9515967 0.9516615 0.9517260
 [99] 0.9517904 0.9518545 0.9519184 0.9519821 0.9520456 0.9521089 0.9521720
[106] 0.9522349 0.9522976 0.9523600 0.9524223 0.9524844 0.9525462 0.9526078
[113] 0.9526693 0.9527305 0.9527915 0.9528523 0.9529129 0.9529732 0.9530334
[120] 0.9530934 0.9531531 0.9532126 0.9532720 0.9533311 0.9533900 0.9534487
[127] 0.9535072 0.9535655 0.9536235 0.9536814 0.9537390 0.9537964 0.9538537
[134] 0.9539107 0.9539675 0.9540241 0.9540804 0.9541366 0.9541925 0.9542483
[141] 0.9543038 0.9543591 0.9544142 0.9544691 0.9545238 0.9545782 0.9546325
[148] 0.9546865 0.9547403 0.9547939 0.9548473 0.9549005 0.9549534 0.9550062
[155] 0.9550587 0.9551110 0.9551631 0.9552150 0.9552667 0.9553182 0.9553694
[162] 0.9554204 0.9554713 0.9555219 0.9555722 0.9556224 0.9556724 0.9557221
[169] 0.9557716 0.9558209 0.9558700 0.9559189 0.9559675 0.9560160 0.9560642
[176] 0.9561122 0.9561600 0.9562076 0.9562549 0.9563021 0.9563490 0.9563957
[183] 0.9564422 0.9564884 0.9565345 0.9565803 0.9566259 0.9566713 0.9567165
[190] 0.9567614 0.9568062 0.9568507 0.9568950 0.9569391 0.9569829 0.9570266
[197] 0.9570700 0.9571132 0.9571562 0.9571990 0.9572415 0.9572838 0.9573260
[204] 0.9573678 0.9574095 0.9574510 0.9574922 0.9575332 0.9575740 0.9576145
[211] 0.9576549 0.9576950 0.9577349 0.9577746 0.9578140 0.9578533 0.9578923
[218] 0.9579311 0.9579697 0.9580080 0.9580461 0.9580841 0.9581217 0.9581592
[225] 0.9581964 0.9582335 0.9582703 0.9583068 0.9583432 0.9583793 0.9584152
[232] 0.9584509 0.9584864 0.9585216 0.9585566 0.9585914 0.9586260 0.9586603
[239] 0.9586944 0.9587283 0.9587620 0.9587955 0.9588287 0.9588617 0.9588945
[246] 0.9589270 0.9589593 0.9589914 0.9590233 0.9590550 0.9590864 0.9591176
[253] 0.9591486 0.9591793 0.9592099 0.9592402 0.9592703 0.9593001 0.9593297
[260] 0.9593591 0.9593883 0.9594173 0.9594460 0.9594745 0.9595028 0.9595308
[267] 0.9595586 0.9595862 0.9596136 0.9596407 0.9596676 0.9596943 0.9597208
[274] 0.9597470 0.9597730 0.9597988 0.9598244 0.9598497 0.9598748 0.9598997
[281] 0.9599243 0.9599487 0.9599729 0.9599969 0.9600206 0.9600441 0.9600674
[288] 0.9600904 0.9601133 0.9601359 0.9601582 0.9601804 0.9602023 0.9602239
[295] 0.9602454 0.9602666 0.9602876 0.9603084 0.9603289 0.9603492 0.9603693
[302] 0.9603892 0.9604088 0.9604282 0.9604473 0.9604663 0.9604850 0.9605034
[309] 0.9605217 0.9605397 0.9605575 0.9605750 0.9605924 0.9606095 0.9606263
[316] 0.9606430 0.9606594 0.9606755 0.9606915 0.9607072 0.9607227 0.9607379
[323] 0.9607529 0.9607677 0.9607823 0.9607966 0.9608107 0.9608246 0.9608382
[330] 0.9608516 0.9608648 0.9608778 0.9608905 0.9609029 0.9609152 0.9609272
[337] 0.9609390 0.9609506 0.9609619 0.9609730 0.9609838 0.9609945 0.9610048
[344] 0.9610150 0.9610249 0.9610346 0.9610441 0.9610533 0.9610623 0.9610711
[351] 0.9610797 0.9610880 0.9610960 0.9611039 0.9611115 0.9611189 0.9611260
[358] 0.9611329 0.9611396 0.9611460 0.9611522 0.9611582 0.9611640 0.9611695
[365] 0.9611748 0.9611798 0.9611846 0.9611892 0.9611935 0.9611976 0.9612015
[372] 0.9612052 0.9612086 0.9612118 0.9612147 0.9612174 0.9612199 0.9612221
[379] 0.9612241 0.9612259 0.9612274 0.9612287 0.9612298 0.9612307 0.9612313
[386] 0.9612316 0.9612318 0.9612317 0.9612313 0.9612308 0.9612300 0.9612289
[393] 0.9612277 0.9612261 0.9612244 0.9612224 0.9612202 0.9612178 0.9612151
[400] 0.9612122 0.9612090
> mx
[1] 0.9612318
> mxli
[1] 1.86
> 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/1spv81226619355.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/2l1is1226619355.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/3pts71226619355.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 
> 
> #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> 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/4pxz91226619355.tab") 
> 
> system("convert tmp/1spv81226619355.ps tmp/1spv81226619355.png")
> system("convert tmp/2l1is1226619355.ps tmp/2l1is1226619355.png")
> system("convert tmp/3pts71226619355.ps tmp/3pts71226619355.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.067   0.519   2.055