R version 2.8.1 (2008-12-22)
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(17,18,23.8,25.5,25.6,23.7,22,21.3,20.7,20.4,20.3,20.4,19.8,19.5,23.1,23.5,23.5,22.9,21.9,21.5,20.5,20.2,19.4,19.2,18.8,18.8,22.6,23.3,23,21.4,19.9,18.8,18.6,18.4,18.6,19.9,19.2,18.4,21.1,20.5,19.1,18.1,17,17.1,17.4,16.8,15.3,14.3,13.4,15.3,22.1,23.7,22.2,19.5,16.6,17.3,19.8,21.2,21.5,20.6)
> x <- c(7.2,7.4,8.8,9.3,9.3,8.7,8.2,8.3,8.5,8.6,8.5,8.2,8.1,7.9,8.6,8.7,8.7,8.5,8.4,8.5,8.7,8.7,8.6,8.5,8.3,8,8.2,8.1,8.1,8,7.9,7.9,8,8,7.9,8,7.7,7.2,7.5,7.3,7,7,7,7.2,7.3,7.1,6.8,6.4,6.1,6.5,7.7,7.9,7.5,6.9,6.6,6.9,7.7,8,8,7.7)
> #'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.8093438 0.8093645 0.8093851 0.8094054 0.8094256 0.8094455 0.8094652
  [8] 0.8094848 0.8095041 0.8095232 0.8095422 0.8095609 0.8095794 0.8095977
 [15] 0.8096158 0.8096338 0.8096515 0.8096690 0.8096863 0.8097034 0.8097203
 [22] 0.8097370 0.8097535 0.8097698 0.8097859 0.8098018 0.8098175 0.8098330
 [29] 0.8098483 0.8098634 0.8098783 0.8098930 0.8099075 0.8099218 0.8099359
 [36] 0.8099498 0.8099635 0.8099770 0.8099903 0.8100034 0.8100163 0.8100290
 [43] 0.8100415 0.8100537 0.8100658 0.8100777 0.8100894 0.8101009 0.8101122
 [50] 0.8101233 0.8101342 0.8101449 0.8101554 0.8101657 0.8101758 0.8101857
 [57] 0.8101954 0.8102049 0.8102142 0.8102233 0.8102322 0.8102409 0.8102494
 [64] 0.8102578 0.8102659 0.8102738 0.8102815 0.8102890 0.8102964 0.8103035
 [71] 0.8103104 0.8103171 0.8103237 0.8103300 0.8103361 0.8103421 0.8103478
 [78] 0.8103534 0.8103587 0.8103639 0.8103688 0.8103736 0.8103782 0.8103825
 [85] 0.8103867 0.8103907 0.8103945 0.8103980 0.8104014 0.8104046 0.8104076
 [92] 0.8104104 0.8104130 0.8104154 0.8104176 0.8104197 0.8104215 0.8104231
 [99] 0.8104245 0.8104258 0.8104268 0.8104277 0.8104283 0.8104288 0.8104290
[106] 0.8104291 0.8104290 0.8104287 0.8104281 0.8104274 0.8104265 0.8104254
[113] 0.8104242 0.8104227 0.8104210 0.8104191 0.8104171 0.8104148 0.8104124
[120] 0.8104097 0.8104069 0.8104039 0.8104007 0.8103972 0.8103936 0.8103898
[127] 0.8103859 0.8103817 0.8103773 0.8103727 0.8103680 0.8103630 0.8103579
[134] 0.8103526 0.8103470 0.8103413 0.8103354 0.8103293 0.8103230 0.8103166
[141] 0.8103099 0.8103030 0.8102960 0.8102888 0.8102813 0.8102737 0.8102659
[148] 0.8102579 0.8102497 0.8102413 0.8102328 0.8102240 0.8102151 0.8102059
[155] 0.8101966 0.8101871 0.8101774 0.8101675 0.8101574 0.8101471 0.8101367
[162] 0.8101260 0.8101152 0.8101042 0.8100930 0.8100816 0.8100700 0.8100582
[169] 0.8100462 0.8100341 0.8100218 0.8100092 0.8099965 0.8099836 0.8099705
[176] 0.8099573 0.8099438 0.8099302 0.8099163 0.8099023 0.8098881 0.8098737
[183] 0.8098592 0.8098444 0.8098294 0.8098143 0.8097990 0.8097835 0.8097678
[190] 0.8097519 0.8097359 0.8097196 0.8097032 0.8096866 0.8096698 0.8096528
[197] 0.8096357 0.8096183 0.8096008 0.8095831 0.8095652 0.8095471 0.8095288
[204] 0.8095104 0.8094917 0.8094729 0.8094539 0.8094347 0.8094154 0.8093958
[211] 0.8093761 0.8093562 0.8093361 0.8093158 0.8092953 0.8092747 0.8092539
[218] 0.8092329 0.8092117 0.8091903 0.8091688 0.8091470 0.8091251 0.8091030
[225] 0.8090808 0.8090583 0.8090357 0.8090129 0.8089899 0.8089667 0.8089433
[232] 0.8089198 0.8088961 0.8088722 0.8088481 0.8088239 0.8087994 0.8087748
[239] 0.8087500 0.8087251 0.8086999 0.8086746 0.8086491 0.8086234 0.8085976
[246] 0.8085715 0.8085453 0.8085189 0.8084924 0.8084656 0.8084387 0.8084116
[253] 0.8083843 0.8083568 0.8083292 0.8083014 0.8082734 0.8082452 0.8082169
[260] 0.8081884 0.8081597 0.8081308 0.8081018 0.8080726 0.8080432 0.8080136
[267] 0.8079839 0.8079539 0.8079239 0.8078936 0.8078631 0.8078325 0.8078017
[274] 0.8077708 0.8077396 0.8077083 0.8076768 0.8076452 0.8076133 0.8075813
[281] 0.8075491 0.8075168 0.8074842 0.8074515 0.8074187 0.8073856 0.8073524
[288] 0.8073190 0.8072854 0.8072517 0.8072178 0.8071837 0.8071495 0.8071150
[295] 0.8070805 0.8070457 0.8070108 0.8069756 0.8069404 0.8069049 0.8068693
[302] 0.8068335 0.8067975 0.8067614 0.8067251 0.8066886 0.8066520 0.8066152
[309] 0.8065782 0.8065411 0.8065038 0.8064663 0.8064286 0.8063908 0.8063528
[316] 0.8063146 0.8062763 0.8062378 0.8061991 0.8061603 0.8061213 0.8060821
[323] 0.8060428 0.8060033 0.8059636 0.8059238 0.8058838 0.8058436 0.8058033
[330] 0.8057628 0.8057221 0.8056813 0.8056403 0.8055991 0.8055578 0.8055163
[337] 0.8054746 0.8054328 0.8053908 0.8053486 0.8053063 0.8052638 0.8052211
[344] 0.8051783 0.8051353 0.8050922 0.8050489 0.8050054 0.8049618 0.8049180
[351] 0.8048740 0.8048299 0.8047856 0.8047411 0.8046965 0.8046517 0.8046068
[358] 0.8045617 0.8045164 0.8044710 0.8044254 0.8043796 0.8043337 0.8042876
[365] 0.8042414 0.8041950 0.8041484 0.8041017 0.8040548 0.8040078 0.8039606
[372] 0.8039132 0.8038657 0.8038180 0.8037702 0.8037222 0.8036740 0.8036257
[379] 0.8035772 0.8035285 0.8034797 0.8034308 0.8033817 0.8033324 0.8032829
[386] 0.8032333 0.8031836 0.8031337 0.8030836 0.8030334 0.8029830 0.8029325
[393] 0.8028818 0.8028309 0.8027799 0.8027287 0.8026774 0.8026259 0.8025743
[400] 0.8025225 0.8024705
> mx
[1] 0.8104291
> mxli
[1] -0.95
> 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/rcomp/tmp/1z0ky1257608499.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/rcomp/tmp/2uelc1257608499.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/rcomp/tmp/3zqim1257608499.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/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/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/rcomp/tmp/4i3vn1257608499.tab") 
> 
> system("convert tmp/1z0ky1257608499.ps tmp/1z0ky1257608499.png")
> system("convert tmp/2uelc1257608499.ps tmp/2uelc1257608499.png")
> system("convert tmp/3zqim1257608499.ps tmp/3zqim1257608499.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.970   0.780   1.324