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(1946.81,1765.9,1635.25,1833.42,1910.43,1959.67,1969.6,2061.41,2093.48,2120.88,2174.56,2196.72,2350.44,2440.25,2408.64,2472.81,2407.6,2454.62,2448.05,2497.84,2645.64,2756.76,2849.27,2921.44,3080.58,3106.22,3119.31,3061.26,3097.31,3161.69,3257.16,3277.01,3295.32,3363.99,3494.17,3667.03,3813.06,3917.96,3895.51,3733.22,3801.06,3570.12,3701.61,3862.27,3970.1,4138.52,4199.75,4290.89,4443.91,4502.64,4356.98,4591.27,4696.96,4621.4,4562.84,4202.52,4296.49,4435.23,4105.18,4116.68)
> x <- c(99.29,98.69,107.92,101.03,97.55,103.02,94.08,94.12,115.08,116.48,103.42,112.51,95.55,97.53,119.26,100.94,97.73,115.25,92.8,99.2,118.69,110.12,110.26,112.9,102.17,99.38,116.1,103.77,101.81,113.74,89.67,99.5,122.89,108.61,114.37,110.5,104.08,103.64,121.61,101.14,115.97,120.12,95.97,105.01,124.68,123.89,123.61,114.76,108.75,106.09,123.17,106.16,115.18,120.6,109.48,114.44,121.44,129.48,124.32,112.59)
> #'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.4914952 0.4915317 0.4915682 0.4916045 0.4916407 0.4916768 0.4917128
  [8] 0.4917487 0.4917845 0.4918202 0.4918558 0.4918913 0.4919267 0.4919620
 [15] 0.4919971 0.4920322 0.4920672 0.4921020 0.4921368 0.4921714 0.4922060
 [22] 0.4922404 0.4922747 0.4923090 0.4923431 0.4923771 0.4924110 0.4924448
 [29] 0.4924785 0.4925121 0.4925456 0.4925790 0.4926123 0.4926455 0.4926786
 [36] 0.4927115 0.4927444 0.4927772 0.4928099 0.4928424 0.4928749 0.4929072
 [43] 0.4929395 0.4929716 0.4930037 0.4930356 0.4930674 0.4930992 0.4931308
 [50] 0.4931623 0.4931937 0.4932250 0.4932563 0.4932874 0.4933184 0.4933493
 [57] 0.4933801 0.4934108 0.4934414 0.4934718 0.4935022 0.4935325 0.4935627
 [64] 0.4935928 0.4936228 0.4936526 0.4936824 0.4937121 0.4937416 0.4937711
 [71] 0.4938004 0.4938297 0.4938589 0.4938879 0.4939169 0.4939457 0.4939744
 [78] 0.4940031 0.4940316 0.4940601 0.4940884 0.4941166 0.4941448 0.4941728
 [85] 0.4942007 0.4942286 0.4942563 0.4942839 0.4943114 0.4943388 0.4943662
 [92] 0.4943934 0.4944205 0.4944475 0.4944744 0.4945012 0.4945279 0.4945545
 [99] 0.4945810 0.4946074 0.4946337 0.4946599 0.4946860 0.4947120 0.4947379
[106] 0.4947637 0.4947894 0.4948150 0.4948405 0.4948659 0.4948912 0.4949164
[113] 0.4949415 0.4949665 0.4949914 0.4950162 0.4950409 0.4950654 0.4950899
[120] 0.4951143 0.4951386 0.4951628 0.4951869 0.4952109 0.4952348 0.4952585
[127] 0.4952822 0.4953058 0.4953293 0.4953527 0.4953760 0.4953992 0.4954223
[134] 0.4954453 0.4954682 0.4954909 0.4955136 0.4955362 0.4955587 0.4955811
[141] 0.4956034 0.4956256 0.4956477 0.4956697 0.4956916 0.4957134 0.4957351
[148] 0.4957567 0.4957782 0.4957996 0.4958209 0.4958421 0.4958633 0.4958843
[155] 0.4959052 0.4959260 0.4959467 0.4959673 0.4959878 0.4960083 0.4960286
[162] 0.4960488 0.4960689 0.4960890 0.4961089 0.4961287 0.4961485 0.4961681
[169] 0.4961877 0.4962071 0.4962264 0.4962457 0.4962648 0.4962839 0.4963029
[176] 0.4963217 0.4963405 0.4963591 0.4963777 0.4963962 0.4964146 0.4964328
[183] 0.4964510 0.4964691 0.4964871 0.4965050 0.4965228 0.4965405 0.4965581
[190] 0.4965756 0.4965930 0.4966103 0.4966275 0.4966446 0.4966616 0.4966786
[197] 0.4966954 0.4967121 0.4967288 0.4967453 0.4967618 0.4967781 0.4967944
[204] 0.4968105 0.4968266 0.4968426 0.4968584 0.4968742 0.4968899 0.4969055
[211] 0.4969210 0.4969364 0.4969517 0.4969669 0.4969820 0.4969970 0.4970119
[218] 0.4970268 0.4970415 0.4970561 0.4970707 0.4970851 0.4970995 0.4971138
[225] 0.4971279 0.4971420 0.4971560 0.4971699 0.4971836 0.4971973 0.4972109
[232] 0.4972244 0.4972379 0.4972512 0.4972644 0.4972775 0.4972906 0.4973035
[239] 0.4973164 0.4973291 0.4973418 0.4973544 0.4973669 0.4973792 0.4973915
[246] 0.4974037 0.4974158 0.4974279 0.4974398 0.4974516 0.4974633 0.4974750
[253] 0.4974865 0.4974980 0.4975094 0.4975206 0.4975318 0.4975429 0.4975539
[260] 0.4975648 0.4975756 0.4975863 0.4975970 0.4976075 0.4976179 0.4976283
[267] 0.4976386 0.4976487 0.4976588 0.4976688 0.4976787 0.4976885 0.4976982
[274] 0.4977078 0.4977174 0.4977268 0.4977361 0.4977454 0.4977546 0.4977636
[281] 0.4977726 0.4977815 0.4977903 0.4977990 0.4978077 0.4978162 0.4978246
[288] 0.4978330 0.4978412 0.4978494 0.4978575 0.4978655 0.4978734 0.4978812
[295] 0.4978889 0.4978966 0.4979041 0.4979115 0.4979189 0.4979262 0.4979334
[302] 0.4979405 0.4979475 0.4979544 0.4979612 0.4979679 0.4979746 0.4979812
[309] 0.4979876 0.4979940 0.4980003 0.4980065 0.4980126 0.4980186 0.4980246
[316] 0.4980304 0.4980362 0.4980419 0.4980475 0.4980529 0.4980584 0.4980637
[323] 0.4980689 0.4980741 0.4980791 0.4980841 0.4980890 0.4980938 0.4980985
[330] 0.4981031 0.4981076 0.4981121 0.4981164 0.4981207 0.4981249 0.4981290
[337] 0.4981330 0.4981369 0.4981407 0.4981445 0.4981481 0.4981517 0.4981552
[344] 0.4981586 0.4981619 0.4981652 0.4981683 0.4981714 0.4981743 0.4981772
[351] 0.4981800 0.4981827 0.4981854 0.4981879 0.4981904 0.4981927 0.4981950
[358] 0.4981972 0.4981993 0.4982013 0.4982033 0.4982051 0.4982069 0.4982086
[365] 0.4982102 0.4982117 0.4982132 0.4982145 0.4982158 0.4982169 0.4982180
[372] 0.4982191 0.4982200 0.4982208 0.4982216 0.4982222 0.4982228 0.4982233
[379] 0.4982238 0.4982241 0.4982243 0.4982245 0.4982246 0.4982246 0.4982245
[386] 0.4982243 0.4982241 0.4982238 0.4982233 0.4982228 0.4982223 0.4982216
[393] 0.4982208 0.4982200 0.4982191 0.4982181 0.4982170 0.4982159 0.4982146
[400] 0.4982133 0.4982119
> mx
[1] 0.4982246
> mxli
[1] 1.83
> 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/1emmy1226055966.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/2v0yc1226055966.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/30z9r1226055966.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/4oz0h1226055966.tab") 
> 
> system("convert tmp/1emmy1226055966.ps tmp/1emmy1226055966.png")
> system("convert tmp/2v0yc1226055966.ps tmp/2v0yc1226055966.png")
> system("convert tmp/30z9r1226055966.ps tmp/30z9r1226055966.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.029   0.547   3.682