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(121148,114624,109822,112081,113534,112110,109826,107423,105540,108573,128591,139145,129700,132828,126868,128390,126830,124105,122323,119296,116822,119224,139357,144322,133676,128283,121640,122877,117284,116463,112685,113235,111692,113152,129889,131153,123770,112516,105940,104320,103582,99064,94989,92241,89752,90610,109456,110213,97694,91844,87572,89812,89050,85990,85070,83277,79586,84215,99708,100698,90861)
> x <- c(308347,298427,289231,291975,294912,293488,290555,284736,281818,287854,316263,325412,326011,328282,317480,317539,313737,312276,309391,302950,300316,304035,333476,337698,335932,323931,313927,314485,313218,309664,302963,298989,298423,301631,329765,335083,327616,309119,295916,291413,291542,284678,276475,272566,264981,263290,296806,303598,286994,276427,266424,267153,268381,262522,255542,253158,243803,250741,280445,285257,270976)
> #'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.9599108 0.9599843 0.9600606 0.9601346 0.9602077 0.9602827 0.9603577
  [8] 0.9604310 0.9605039 0.9605774 0.9606507 0.9607230 0.9607956 0.9608687
 [15] 0.9609407 0.9610124 0.9610839 0.9611557 0.9612269 0.9612983 0.9613687
 [22] 0.9614395 0.9615097 0.9615800 0.9616501 0.9617197 0.9617894 0.9618587
 [29] 0.9619278 0.9619968 0.9620654 0.9621339 0.9622022 0.9622702 0.9623380
 [36] 0.9624056 0.9624730 0.9625402 0.9626071 0.9626739 0.9627403 0.9628066
 [43] 0.9628727 0.9629386 0.9630042 0.9630697 0.9631349 0.9631999 0.9632646
 [50] 0.9633292 0.9633935 0.9634576 0.9635215 0.9635852 0.9636487 0.9637119
 [57] 0.9637750 0.9638378 0.9639003 0.9639627 0.9640249 0.9640868 0.9641485
 [64] 0.9642100 0.9642713 0.9643324 0.9643932 0.9644538 0.9645142 0.9645744
 [71] 0.9646344 0.9646941 0.9647537 0.9648130 0.9648721 0.9649309 0.9649896
 [78] 0.9650480 0.9651062 0.9651642 0.9652220 0.9652796 0.9653369 0.9653940
 [85] 0.9654509 0.9655076 0.9655641 0.9656203 0.9656763 0.9657321 0.9657877
 [92] 0.9658431 0.9658982 0.9659532 0.9660079 0.9660623 0.9661166 0.9661707
 [99] 0.9662245 0.9662781 0.9663315 0.9663847 0.9664376 0.9664903 0.9665428
[106] 0.9665951 0.9666472 0.9666991 0.9667507 0.9668021 0.9668533 0.9669043
[113] 0.9669550 0.9670055 0.9670559 0.9671059 0.9671558 0.9672055 0.9672549
[120] 0.9673041 0.9673531 0.9674019 0.9674504 0.9674988 0.9675469 0.9675948
[127] 0.9676424 0.9676899 0.9677371 0.9677841 0.9678309 0.9678775 0.9679239
[134] 0.9679700 0.9680159 0.9680616 0.9681071 0.9681523 0.9681974 0.9682422
[141] 0.9682868 0.9683312 0.9683753 0.9684192 0.9684630 0.9685064 0.9685497
[148] 0.9685928 0.9686356 0.9686782 0.9687206 0.9687628 0.9688047 0.9688465
[155] 0.9688880 0.9689293 0.9689704 0.9690112 0.9690519 0.9690923 0.9691325
[162] 0.9691724 0.9692122 0.9692517 0.9692910 0.9693301 0.9693690 0.9694077
[169] 0.9694461 0.9694843 0.9695223 0.9695601 0.9695977 0.9696350 0.9696721
[176] 0.9697090 0.9697457 0.9697822 0.9698184 0.9698544 0.9698902 0.9699258
[183] 0.9699612 0.9699963 0.9700312 0.9700659 0.9701004 0.9701347 0.9701687
[190] 0.9702026 0.9702362 0.9702696 0.9703027 0.9703357 0.9703684 0.9704009
[197] 0.9704332 0.9704653 0.9704972 0.9705288 0.9705602 0.9705914 0.9706224
[204] 0.9706532 0.9706837 0.9707140 0.9707441 0.9707740 0.9708037 0.9708331
[211] 0.9708624 0.9708914 0.9709202 0.9709487 0.9709771 0.9710052 0.9710332
[218] 0.9710609 0.9710883 0.9711156 0.9711427 0.9711695 0.9711961 0.9712225
[225] 0.9712487 0.9712746 0.9713004 0.9713259 0.9713512 0.9713763 0.9714011
[232] 0.9714258 0.9714502 0.9714744 0.9714984 0.9715222 0.9715458 0.9715691
[239] 0.9715922 0.9716151 0.9716378 0.9716603 0.9716826 0.9717046 0.9717264
[246] 0.9717481 0.9717694 0.9717906 0.9718116 0.9718323 0.9718528 0.9718731
[253] 0.9718932 0.9719131 0.9719328 0.9719522 0.9719714 0.9719904 0.9720092
[260] 0.9720278 0.9720462 0.9720643 0.9720823 0.9721000 0.9721175 0.9721347
[267] 0.9721518 0.9721687 0.9721853 0.9722017 0.9722179 0.9722339 0.9722497
[274] 0.9722652 0.9722806 0.9722957 0.9723106 0.9723253 0.9723398 0.9723541
[281] 0.9723681 0.9723820 0.9723956 0.9724090 0.9724222 0.9724352 0.9724479
[288] 0.9724605 0.9724728 0.9724850 0.9724969 0.9725086 0.9725201 0.9725313
[295] 0.9725424 0.9725532 0.9725639 0.9725743 0.9725845 0.9725945 0.9726042
[302] 0.9726138 0.9726231 0.9726323 0.9726412 0.9726499 0.9726584 0.9726667
[309] 0.9726748 0.9726826 0.9726903 0.9726977 0.9727050 0.9727120 0.9727188
[316] 0.9727254 0.9727317 0.9727379 0.9727439 0.9727496 0.9727551 0.9727604
[323] 0.9727656 0.9727704 0.9727751 0.9727796 0.9727839 0.9727879 0.9727918
[330] 0.9727954 0.9727988 0.9728020 0.9728050 0.9728078 0.9728104 0.9728128
[337] 0.9728149 0.9728169 0.9728186 0.9728202 0.9728215 0.9728226 0.9728235
[344] 0.9728242 0.9728247 0.9728250 0.9728250 0.9728249 0.9728245 0.9728240
[351] 0.9728232 0.9728222 0.9728210 0.9728197 0.9728181 0.9728162 0.9728142
[358] 0.9728120 0.9728096 0.9728069 0.9728041 0.9728010 0.9727978 0.9727943
[365] 0.9727906 0.9727867 0.9727827 0.9727784 0.9727739 0.9727692 0.9727642
[372] 0.9727591 0.9727538 0.9727483 0.9727425 0.9727366 0.9727304 0.9727241
[379] 0.9727175 0.9727107 0.9727038 0.9726966 0.9726892 0.9726816 0.9726738
[386] 0.9726658 0.9726576 0.9726492 0.9726406 0.9726318 0.9726228 0.9726136
[393] 0.9726041 0.9725945 0.9725847 0.9725746 0.9725644 0.9725540 0.9725433
[400] 0.9725325 0.9725214
> mx
[1] 0.972825
> mxli
[1] 1.46
> 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/1ozmr1226438307.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/2rgyn1226438307.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/3n9rg1226438307.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/4vw9e1226438307.tab") 
> 
> system("convert tmp/1ozmr1226438307.ps tmp/1ozmr1226438307.png")
> system("convert tmp/2rgyn1226438307.ps tmp/2rgyn1226438307.png")
> system("convert tmp/3n9rg1226438307.ps tmp/3n9rg1226438307.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.009   0.523   1.351