R version 2.9.0 (2009-04-17)
Copyright (C) 2009 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(562325,560854,555332,543599,536662,542722,593530,610763,612613,611324,594167,595454,590865,589379,584428,573100,567456,569028,620735,628884,628232,612117,595404,597141,593408,590072,579799,574205,572775,572942,619567,625809,619916,587625,565742,557274,560576,548854,531673,525919,511038,498662,555362,564591,541657,527070,509846,514258,516922,507561,492622,490243,469357,477580,528379,533590,517945,506174,501866,516141)
> x <- c(8.6,8.5,8.3,7.8,7.8,8,8.6,8.9,8.9,8.6,8.3,8.3,8.3,8.4,8.5,8.4,8.6,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.5,8.6,8.4,8.1,8,8,8,8,7.9,7.8,7.8,7.9,8.1,8,7.6,7.3,7,6.8,7,7.1,7.2,7.1,6.9,6.7,6.7,6.6,6.9,7.3,7.5,7.3,7.1,6.9,7.1)
> #'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.8070433 0.8070672 0.8070909 0.8071145 0.8071380 0.8071615 0.8071849
  [8] 0.8072082 0.8072313 0.8072545 0.8072775 0.8073004 0.8073232 0.8073460
 [15] 0.8073687 0.8073913 0.8074137 0.8074361 0.8074585 0.8074807 0.8075028
 [22] 0.8075249 0.8075468 0.8075687 0.8075905 0.8076122 0.8076338 0.8076553
 [29] 0.8076768 0.8076981 0.8077194 0.8077406 0.8077616 0.8077826 0.8078035
 [36] 0.8078243 0.8078451 0.8078657 0.8078863 0.8079067 0.8079271 0.8079474
 [43] 0.8079676 0.8079877 0.8080077 0.8080276 0.8080475 0.8080672 0.8080869
 [50] 0.8081065 0.8081259 0.8081453 0.8081646 0.8081839 0.8082030 0.8082220
 [57] 0.8082410 0.8082598 0.8082786 0.8082973 0.8083159 0.8083344 0.8083528
 [64] 0.8083711 0.8083894 0.8084075 0.8084256 0.8084435 0.8084614 0.8084792
 [71] 0.8084969 0.8085145 0.8085320 0.8085495 0.8085668 0.8085840 0.8086012
 [78] 0.8086183 0.8086353 0.8086521 0.8086689 0.8086857 0.8087023 0.8087188
 [85] 0.8087352 0.8087516 0.8087679 0.8087840 0.8088001 0.8088161 0.8088320
 [92] 0.8088478 0.8088635 0.8088792 0.8088947 0.8089102 0.8089255 0.8089408
 [99] 0.8089560 0.8089710 0.8089860 0.8090010 0.8090158 0.8090305 0.8090451
[106] 0.8090597 0.8090741 0.8090885 0.8091028 0.8091170 0.8091310 0.8091450
[113] 0.8091590 0.8091728 0.8091865 0.8092001 0.8092137 0.8092271 0.8092405
[120] 0.8092538 0.8092670 0.8092801 0.8092931 0.8093060 0.8093188 0.8093315
[127] 0.8093442 0.8093567 0.8093692 0.8093815 0.8093938 0.8094060 0.8094181
[134] 0.8094301 0.8094420 0.8094538 0.8094655 0.8094772 0.8094887 0.8095002
[141] 0.8095115 0.8095228 0.8095340 0.8095451 0.8095561 0.8095670 0.8095778
[148] 0.8095885 0.8095992 0.8096097 0.8096201 0.8096305 0.8096408 0.8096509
[155] 0.8096610 0.8096710 0.8096809 0.8096907 0.8097004 0.8097100 0.8097196
[162] 0.8097290 0.8097384 0.8097476 0.8097568 0.8097659 0.8097748 0.8097837
[169] 0.8097925 0.8098012 0.8098098 0.8098184 0.8098268 0.8098351 0.8098434
[176] 0.8098515 0.8098596 0.8098676 0.8098754 0.8098832 0.8098909 0.8098985
[183] 0.8099060 0.8099134 0.8099208 0.8099280 0.8099351 0.8099422 0.8099491
[190] 0.8099560 0.8099628 0.8099695 0.8099760 0.8099825 0.8099889 0.8099953
[197] 0.8100015 0.8100076 0.8100136 0.8100196 0.8100254 0.8100312 0.8100368
[204] 0.8100424 0.8100479 0.8100533 0.8100586 0.8100638 0.8100689 0.8100739
[211] 0.8100788 0.8100837 0.8100884 0.8100930 0.8100976 0.8101021 0.8101064
[218] 0.8101107 0.8101149 0.8101190 0.8101230 0.8101269 0.8101307 0.8101344
[225] 0.8101380 0.8101416 0.8101450 0.8101484 0.8101516 0.8101548 0.8101579
[232] 0.8101608 0.8101637 0.8101665 0.8101692 0.8101718 0.8101744 0.8101768
[239] 0.8101791 0.8101813 0.8101835 0.8101855 0.8101875 0.8101894 0.8101911
[246] 0.8101928 0.8101944 0.8101959 0.8101973 0.8101986 0.8101998 0.8102009
[253] 0.8102020 0.8102029 0.8102038 0.8102045 0.8102052 0.8102057 0.8102062
[260] 0.8102066 0.8102069 0.8102071 0.8102072 0.8102072 0.8102071 0.8102069
[267] 0.8102066 0.8102063 0.8102058 0.8102053 0.8102046 0.8102039 0.8102030
[274] 0.8102021 0.8102011 0.8102000 0.8101988 0.8101975 0.8101961 0.8101946
[281] 0.8101931 0.8101914 0.8101896 0.8101878 0.8101858 0.8101838 0.8101816
[288] 0.8101794 0.8101771 0.8101747 0.8101722 0.8101696 0.8101669 0.8101641
[295] 0.8101612 0.8101583 0.8101552 0.8101520 0.8101488 0.8101454 0.8101420
[302] 0.8101385 0.8101349 0.8101311 0.8101273 0.8101234 0.8101194 0.8101153
[309] 0.8101112 0.8101069 0.8101025 0.8100981 0.8100935 0.8100889 0.8100841
[316] 0.8100793 0.8100743 0.8100693 0.8100642 0.8100590 0.8100537 0.8100483
[323] 0.8100428 0.8100373 0.8100316 0.8100258 0.8100200 0.8100140 0.8100080
[330] 0.8100018 0.8099956 0.8099893 0.8099828 0.8099763 0.8099697 0.8099630
[337] 0.8099562 0.8099494 0.8099424 0.8099353 0.8099282 0.8099209 0.8099135
[344] 0.8099061 0.8098986 0.8098909 0.8098832 0.8098754 0.8098675 0.8098595
[351] 0.8098514 0.8098432 0.8098349 0.8098266 0.8098181 0.8098095 0.8098009
[358] 0.8097921 0.8097833 0.8097744 0.8097654 0.8097562 0.8097470 0.8097377
[365] 0.8097283 0.8097188 0.8097093 0.8096996 0.8096898 0.8096800 0.8096700
[372] 0.8096600 0.8096498 0.8096396 0.8096293 0.8096188 0.8096083 0.8095977
[379] 0.8095870 0.8095762 0.8095654 0.8095544 0.8095433 0.8095321 0.8095209
[386] 0.8095095 0.8094981 0.8094866 0.8094749 0.8094632 0.8094514 0.8094395
[393] 0.8094275 0.8094154 0.8094032 0.8093910 0.8093786 0.8093661 0.8093536
[400] 0.8093409 0.8093282
> mx
[1] 0.8102072
> mxli
[1] 0.63
> 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/1rw361257684902.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/296q01257684902.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/3x42c1257684902.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/4xcgr1257684902.tab") 
> 
> system("convert tmp/1rw361257684902.ps tmp/1rw361257684902.png")
> system("convert tmp/296q01257684902.ps tmp/296q01257684902.png")
> system("convert tmp/3x42c1257684902.ps tmp/3x42c1257684902.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.773   0.510  25.283