R version 2.8.0 (2008-10-20)
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(2400,4700,3700,2900,2800,3000,3100,3700,3000,2000,1900,1900,1800,3400,3800,2800,3100,2100,2000,2500,2400,2500,3300,3100,3700,5600,3700,2900,4000,2900,2400,3300,3800,4400,4000,3100,2700,5200,4600,3700,3200,2400,2200,3200,3100,2300,2500,2900,2700,5000,3500,3000,3800,2800,2400,2700,2800,2700,2600,3100)
> x <- c(5014,6153,6441,5584,6427,6062,5589,6216,5809,4989,6706,7174,6122,8075,6292,6337,8576,6077,5931,6288,7167,6054,6468,6401,6927,7914,7728,8699,8522,6481,7502,7778,7424,6941,8574,9169,7701,9035,7158,8195,8124,7073,7017,7390,7776,6197,6889,7087,6485,7654,6501,6313,7826,6589,6729,5684,8105,6391,5901,6758)
> #'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.4185766 0.4186611 0.4187454 0.4188294 0.4189130 0.4189963 0.4190794
  [8] 0.4191621 0.4192445 0.4193266 0.4194084 0.4194898 0.4195710 0.4196518
 [15] 0.4197324 0.4198126 0.4198925 0.4199721 0.4200514 0.4201304 0.4202091
 [22] 0.4202874 0.4203655 0.4204432 0.4205206 0.4205977 0.4206745 0.4207510
 [29] 0.4208271 0.4209030 0.4209785 0.4210537 0.4211287 0.4212032 0.4212775
 [36] 0.4213515 0.4214251 0.4214985 0.4215715 0.4216442 0.4217166 0.4217887
 [43] 0.4218605 0.4219319 0.4220030 0.4220739 0.4221444 0.4222146 0.4222844
 [50] 0.4223540 0.4224232 0.4224922 0.4225608 0.4226291 0.4226971 0.4227647
 [57] 0.4228321 0.4228991 0.4229658 0.4230322 0.4230983 0.4231641 0.4232295
 [64] 0.4232947 0.4233595 0.4234240 0.4234882 0.4235521 0.4236157 0.4236789
 [71] 0.4237418 0.4238044 0.4238667 0.4239287 0.4239904 0.4240517 0.4241128
 [78] 0.4241735 0.4242339 0.4242940 0.4243537 0.4244132 0.4244723 0.4245311
 [85] 0.4245896 0.4246478 0.4247057 0.4247633 0.4248205 0.4248774 0.4249340
 [92] 0.4249903 0.4250463 0.4251020 0.4251573 0.4252124 0.4252671 0.4253215
 [99] 0.4253756 0.4254293 0.4254828 0.4255359 0.4255887 0.4256413 0.4256934
[106] 0.4257453 0.4257969 0.4258481 0.4258991 0.4259497 0.4260000 0.4260500
[113] 0.4260997 0.4261490 0.4261981 0.4262468 0.4262952 0.4263434 0.4263911
[120] 0.4264386 0.4264858 0.4265326 0.4265792 0.4266254 0.4266713 0.4267169
[127] 0.4267622 0.4268072 0.4268518 0.4268962 0.4269402 0.4269840 0.4270274
[134] 0.4270705 0.4271133 0.4271557 0.4271979 0.4272398 0.4272813 0.4273225
[141] 0.4273634 0.4274041 0.4274444 0.4274843 0.4275240 0.4275634 0.4276024
[148] 0.4276412 0.4276796 0.4277177 0.4277556 0.4277931 0.4278303 0.4278672
[155] 0.4279037 0.4279400 0.4279760 0.4280116 0.4280470 0.4280820 0.4281167
[162] 0.4281512 0.4281853 0.4282191 0.4282526 0.4282858 0.4283187 0.4283513
[169] 0.4283835 0.4284155 0.4284472 0.4284785 0.4285096 0.4285403 0.4285707
[176] 0.4286009 0.4286307 0.4286602 0.4286895 0.4287184 0.4287470 0.4287753
[183] 0.4288033 0.4288310 0.4288584 0.4288855 0.4289123 0.4289388 0.4289650
[190] 0.4289909 0.4290164 0.4290417 0.4290667 0.4290914 0.4291158 0.4291399
[197] 0.4291636 0.4291871 0.4292103 0.4292332 0.4292558 0.4292780 0.4293000
[204] 0.4293217 0.4293431 0.4293642 0.4293850 0.4294054 0.4294256 0.4294455
[211] 0.4294651 0.4294844 0.4295034 0.4295222 0.4295406 0.4295587 0.4295765
[218] 0.4295940 0.4296113 0.4296282 0.4296449 0.4296612 0.4296773 0.4296930
[225] 0.4297085 0.4297237 0.4297385 0.4297531 0.4297674 0.4297814 0.4297952
[232] 0.4298086 0.4298217 0.4298346 0.4298471 0.4298594 0.4298713 0.4298830
[239] 0.4298944 0.4299055 0.4299163 0.4299269 0.4299371 0.4299470 0.4299567
[246] 0.4299661 0.4299752 0.4299840 0.4299925 0.4300007 0.4300086 0.4300163
[253] 0.4300237 0.4300307 0.4300375 0.4300441 0.4300503 0.4300562 0.4300619
[260] 0.4300673 0.4300724 0.4300772 0.4300817 0.4300860 0.4300900 0.4300936
[267] 0.4300971 0.4301002 0.4301030 0.4301056 0.4301079 0.4301099 0.4301116
[274] 0.4301131 0.4301142 0.4301151 0.4301157 0.4301161 0.4301161 0.4301159
[281] 0.4301154 0.4301147 0.4301136 0.4301123 0.4301107 0.4301088 0.4301067
[288] 0.4301043 0.4301016 0.4300986 0.4300953 0.4300918 0.4300880 0.4300840
[295] 0.4300797 0.4300750 0.4300702 0.4300650 0.4300596 0.4300539 0.4300480
[302] 0.4300417 0.4300352 0.4300285 0.4300214 0.4300141 0.4300066 0.4299987
[309] 0.4299906 0.4299823 0.4299736 0.4299647 0.4299555 0.4299461 0.4299364
[316] 0.4299264 0.4299162 0.4299057 0.4298950 0.4298839 0.4298726 0.4298611
[323] 0.4298493 0.4298372 0.4298249 0.4298123 0.4297994 0.4297863 0.4297729
[330] 0.4297593 0.4297454 0.4297312 0.4297168 0.4297021 0.4296872 0.4296720
[337] 0.4296566 0.4296409 0.4296249 0.4296087 0.4295922 0.4295755 0.4295585
[344] 0.4295412 0.4295237 0.4295060 0.4294880 0.4294697 0.4294512 0.4294325
[351] 0.4294134 0.4293942 0.4293746 0.4293549 0.4293349 0.4293146 0.4292941
[358] 0.4292733 0.4292523 0.4292310 0.4292095 0.4291877 0.4291657 0.4291434
[365] 0.4291209 0.4290981 0.4290751 0.4290518 0.4290283 0.4290046 0.4289806
[372] 0.4289564 0.4289319 0.4289072 0.4288822 0.4288570 0.4288315 0.4288058
[379] 0.4287799 0.4287537 0.4287273 0.4287006 0.4286737 0.4286465 0.4286192
[386] 0.4285915 0.4285637 0.4285355 0.4285072 0.4284786 0.4284498 0.4284207
[393] 0.4283914 0.4283619 0.4283321 0.4283021 0.4282719 0.4282414 0.4282107
[400] 0.4281797 0.4281486
> mx
[1] 0.4301161
> mxli
[1] 0.78
> 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/11lun1228920187.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/26vw31228920187.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/3jo2l1228920187.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/4e53p1228920187.tab") 
> 
> system("convert tmp/11lun1228920187.ps tmp/11lun1228920187.png")
> system("convert tmp/26vw31228920187.ps tmp/26vw31228920187.png")
> system("convert tmp/3jo2l1228920187.ps tmp/3jo2l1228920187.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.782   0.493   0.940