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(4881,4899,4923,4940,4956,4959,4972,4983,4994,5007,5018,5042,5068,5087,5112,5144,5182,5224)
> x <- c(9987,10022,10068,10101,10131,10143,10170,10192,10214,10239,10263,10310,10355,10396,10446,10511,10585,10667)
> #'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.9993844 0.9993876 0.9993907 0.9993938 0.9993969 0.9994000 0.9994031
  [8] 0.9994061 0.9994092 0.9994123 0.9994153 0.9994183 0.9994214 0.9994244
 [15] 0.9994274 0.9994304 0.9994334 0.9994364 0.9994394 0.9994423 0.9994453
 [22] 0.9994482 0.9994512 0.9994541 0.9994570 0.9994599 0.9994628 0.9994657
 [29] 0.9994686 0.9994715 0.9994744 0.9994772 0.9994801 0.9994829 0.9994857
 [36] 0.9994886 0.9994914 0.9994942 0.9994970 0.9994998 0.9995025 0.9995053
 [43] 0.9995081 0.9995108 0.9995136 0.9995163 0.9995190 0.9995217 0.9995244
 [50] 0.9995271 0.9995298 0.9995325 0.9995352 0.9995378 0.9995405 0.9995431
 [57] 0.9995458 0.9995484 0.9995510 0.9995536 0.9995562 0.9995588 0.9995614
 [64] 0.9995639 0.9995665 0.9995691 0.9995716 0.9995741 0.9995767 0.9995792
 [71] 0.9995817 0.9995842 0.9995867 0.9995892 0.9995916 0.9995941 0.9995965
 [78] 0.9995990 0.9996014 0.9996039 0.9996063 0.9996087 0.9996111 0.9996135
 [85] 0.9996159 0.9996182 0.9996206 0.9996229 0.9996253 0.9996276 0.9996300
 [92] 0.9996323 0.9996346 0.9996369 0.9996392 0.9996415 0.9996437 0.9996460
 [99] 0.9996483 0.9996505 0.9996527 0.9996550 0.9996572 0.9996594 0.9996616
[106] 0.9996638 0.9996660 0.9996682 0.9996703 0.9996725 0.9996746 0.9996768
[113] 0.9996789 0.9996810 0.9996831 0.9996852 0.9996873 0.9996894 0.9996915
[120] 0.9996936 0.9996956 0.9996977 0.9996997 0.9997017 0.9997038 0.9997058
[127] 0.9997078 0.9997098 0.9997118 0.9997137 0.9997157 0.9997177 0.9997196
[134] 0.9997215 0.9997235 0.9997254 0.9997273 0.9997292 0.9997311 0.9997330
[141] 0.9997349 0.9997367 0.9997386 0.9997405 0.9997423 0.9997441 0.9997460
[148] 0.9997478 0.9997496 0.9997514 0.9997532 0.9997549 0.9997567 0.9997585
[155] 0.9997602 0.9997620 0.9997637 0.9997654 0.9997671 0.9997688 0.9997705
[162] 0.9997722 0.9997739 0.9997756 0.9997772 0.9997789 0.9997805 0.9997822
[169] 0.9997838 0.9997854 0.9997870 0.9997886 0.9997902 0.9997918 0.9997934
[176] 0.9997949 0.9997965 0.9997980 0.9997996 0.9998011 0.9998026 0.9998041
[183] 0.9998056 0.9998071 0.9998086 0.9998101 0.9998115 0.9998130 0.9998144
[190] 0.9998159 0.9998173 0.9998187 0.9998201 0.9998215 0.9998229 0.9998243
[197] 0.9998257 0.9998270 0.9998284 0.9998297 0.9998311 0.9998324 0.9998337
[204] 0.9998350 0.9998363 0.9998376 0.9998389 0.9998402 0.9998414 0.9998427
[211] 0.9998439 0.9998452 0.9998464 0.9998476 0.9998488 0.9998500 0.9998512
[218] 0.9998524 0.9998536 0.9998548 0.9998559 0.9998571 0.9998582 0.9998593
[225] 0.9998605 0.9998616 0.9998627 0.9998638 0.9998649 0.9998659 0.9998670
[232] 0.9998681 0.9998691 0.9998701 0.9998712 0.9998722 0.9998732 0.9998742
[239] 0.9998752 0.9998762 0.9998772 0.9998781 0.9998791 0.9998800 0.9998810
[246] 0.9998819 0.9998828 0.9998838 0.9998847 0.9998856 0.9998864 0.9998873
[253] 0.9998882 0.9998890 0.9998899 0.9998907 0.9998916 0.9998924 0.9998932
[260] 0.9998940 0.9998948 0.9998956 0.9998964 0.9998971 0.9998979 0.9998987
[267] 0.9998994 0.9999001 0.9999009 0.9999016 0.9999023 0.9999030 0.9999037
[274] 0.9999043 0.9999050 0.9999057 0.9999063 0.9999070 0.9999076 0.9999082
[281] 0.9999088 0.9999095 0.9999101 0.9999106 0.9999112 0.9999118 0.9999124
[288] 0.9999129 0.9999135 0.9999140 0.9999145 0.9999150 0.9999155 0.9999160
[295] 0.9999165 0.9999170 0.9999175 0.9999179 0.9999184 0.9999188 0.9999193
[302] 0.9999197 0.9999201 0.9999205 0.9999209 0.9999213 0.9999217 0.9999221
[309] 0.9999224 0.9999228 0.9999231 0.9999235 0.9999238 0.9999241 0.9999244
[316] 0.9999247 0.9999250 0.9999253 0.9999256 0.9999259 0.9999261 0.9999264
[323] 0.9999266 0.9999268 0.9999270 0.9999273 0.9999275 0.9999276 0.9999278
[330] 0.9999280 0.9999282 0.9999283 0.9999285 0.9999286 0.9999287 0.9999289
[337] 0.9999290 0.9999291 0.9999292 0.9999293 0.9999293 0.9999294 0.9999295
[344] 0.9999295 0.9999295 0.9999296 0.9999296 0.9999296 0.9999296 0.9999296
[351] 0.9999296 0.9999296 0.9999295 0.9999295 0.9999294 0.9999294 0.9999293
[358] 0.9999292 0.9999292 0.9999291 0.9999290 0.9999288 0.9999287 0.9999286
[365] 0.9999284 0.9999283 0.9999281 0.9999280 0.9999278 0.9999276 0.9999274
[372] 0.9999272 0.9999270 0.9999268 0.9999265 0.9999263 0.9999261 0.9999258
[379] 0.9999255 0.9999253 0.9999250 0.9999247 0.9999244 0.9999241 0.9999237
[386] 0.9999234 0.9999231 0.9999227 0.9999224 0.9999220 0.9999216 0.9999212
[393] 0.9999208 0.9999204 0.9999200 0.9999196 0.9999192 0.9999187 0.9999183
[400] 0.9999178 0.9999174
> mx
[1] 0.9999296
> mxli
[1] 1.48
> 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/18k1o1226503518.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/2pgh01226503518.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/37zvk1226503518.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/4udqv1226503518.tab") 
> 
> system("convert tmp/18k1o1226503518.ps tmp/18k1o1226503518.png")
> system("convert tmp/2pgh01226503518.ps tmp/2pgh01226503518.png")
> system("convert tmp/37zvk1226503518.ps tmp/37zvk1226503518.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.000   0.528   1.152