R version 2.7.0 (2008-04-22)
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(565464,547344,554788,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)
> x <- c(217859,208679,213188,216234,213587,209465,204045,200237,203666,241476,260307,243324,244460,233575,237217,235243,230354,227184,221678,217142,219452,256446,265845,248624,241114,229245,231805,219277,219313,212610,214771,211142,211457,240048,240636,230580,208795,197922,194596,194581,185686,178106,172608,167302,168053,202300,202388,182516,173476,166444,171297,169701,164182,161914,159612,151001,158114,186530,187069,174330)
> #'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.9536355 0.9537137 0.9537918 0.9538700 0.9539471 0.9540237 0.9541003
  [8] 0.9541768 0.9542528 0.9543280 0.9544032 0.9544779 0.9545523 0.9546261
 [15] 0.9546997 0.9547730 0.9548458 0.9549183 0.9549904 0.9550621 0.9551334
 [22] 0.9552044 0.9552750 0.9553452 0.9554150 0.9554844 0.9555535 0.9556222
 [29] 0.9556905 0.9557584 0.9558259 0.9558930 0.9559598 0.9560261 0.9560921
 [36] 0.9561577 0.9562229 0.9562877 0.9563521 0.9564161 0.9564798 0.9565430
 [43] 0.9566058 0.9566683 0.9567304 0.9567920 0.9568533 0.9569142 0.9569747
 [50] 0.9570348 0.9570945 0.9571538 0.9572127 0.9572712 0.9573293 0.9573870
 [57] 0.9574443 0.9575012 0.9575577 0.9576138 0.9576695 0.9577248 0.9577797
 [64] 0.9578342 0.9578883 0.9579419 0.9579952 0.9580481 0.9581005 0.9581526
 [71] 0.9582042 0.9582555 0.9583063 0.9583567 0.9584067 0.9584563 0.9585055
 [78] 0.9585543 0.9586027 0.9586506 0.9586981 0.9587453 0.9587920 0.9588383
 [85] 0.9588841 0.9589296 0.9589746 0.9590193 0.9590635 0.9591073 0.9591506
 [92] 0.9591936 0.9592361 0.9592782 0.9593199 0.9593612 0.9594021 0.9594425
 [99] 0.9594825 0.9595221 0.9595612 0.9596000 0.9596383 0.9596762 0.9597136
[106] 0.9597506 0.9597872 0.9598234 0.9598592 0.9598945 0.9599294 0.9599638
[113] 0.9599979 0.9600315 0.9600646 0.9600974 0.9601297 0.9601616 0.9601930
[120] 0.9602240 0.9602546 0.9602847 0.9603144 0.9603437 0.9603725 0.9604009
[127] 0.9604289 0.9604564 0.9604835 0.9605101 0.9605363 0.9605621 0.9605874
[134] 0.9606123 0.9606368 0.9606608 0.9606844 0.9607075 0.9607302 0.9607524
[141] 0.9607742 0.9607956 0.9608165 0.9608370 0.9608570 0.9608766 0.9608957
[148] 0.9609144 0.9609326 0.9609504 0.9609677 0.9609846 0.9610011 0.9610171
[155] 0.9610326 0.9610477 0.9610624 0.9610766 0.9610903 0.9611036 0.9611165
[162] 0.9611289 0.9611408 0.9611523 0.9611633 0.9611739 0.9611840 0.9611937
[169] 0.9612029 0.9612117 0.9612200 0.9612278 0.9612352 0.9612422 0.9612487
[176] 0.9612547 0.9612602 0.9612654 0.9612700 0.9612742 0.9612779 0.9612812
[183] 0.9612840 0.9612864 0.9612882 0.9612897 0.9612906 0.9612911 0.9612912
[190] 0.9612908 0.9612899 0.9612885 0.9612867 0.9612845 0.9612817 0.9612785
[197] 0.9612748 0.9612707 0.9612661 0.9612610 0.9612555 0.9612495 0.9612431
[204] 0.9612361 0.9612287 0.9612209 0.9612125 0.9612037 0.9611945 0.9611847
[211] 0.9611745 0.9611638 0.9611527 0.9611411 0.9611290 0.9611164 0.9611034
[218] 0.9610899 0.9610759 0.9610615 0.9610465 0.9610311 0.9610153 0.9609989
[225] 0.9609821 0.9609649 0.9609471 0.9609289 0.9609102 0.9608910 0.9608713
[232] 0.9608512 0.9608306 0.9608095 0.9607880 0.9607659 0.9607434 0.9607204
[239] 0.9606970 0.9606730 0.9606486 0.9606237 0.9605984 0.9605725 0.9605462
[246] 0.9605194 0.9604921 0.9604644 0.9604361 0.9604074 0.9603782 0.9603485
[253] 0.9603184 0.9602877 0.9602566 0.9602250 0.9601930 0.9601604 0.9601274
[260] 0.9600939 0.9600599 0.9600254 0.9599904 0.9599550 0.9599191 0.9598826
[267] 0.9598458 0.9598084 0.9597705 0.9597322 0.9596934 0.9596541 0.9596143
[274] 0.9595741 0.9595333 0.9594921 0.9594504 0.9594082 0.9593655 0.9593223
[281] 0.9592787 0.9592345 0.9591899 0.9591448 0.9590992 0.9590532 0.9590066
[288] 0.9589596 0.9589121 0.9588641 0.9588156 0.9587666 0.9587171 0.9586672
[295] 0.9586168 0.9585659 0.9585145 0.9584626 0.9584102 0.9583573 0.9583040
[302] 0.9582502 0.9581959 0.9581411 0.9580858 0.9580300 0.9579738 0.9579170
[309] 0.9578598 0.9578021 0.9577439 0.9576852 0.9576260 0.9575664 0.9575062
[316] 0.9574456 0.9573845 0.9573229 0.9572608 0.9571982 0.9571352 0.9570716
[323] 0.9570076 0.9569431 0.9568781 0.9568126 0.9567466 0.9566802 0.9566132
[330] 0.9565458 0.9564779 0.9564095 0.9563406 0.9562712 0.9562013 0.9561310
[337] 0.9560602 0.9559889 0.9559171 0.9558448 0.9557720 0.9556987 0.9556250
[344] 0.9555508 0.9554761 0.9554009 0.9553252 0.9552490 0.9551724 0.9550952
[351] 0.9550176 0.9549395 0.9548609 0.9547818 0.9547023 0.9546222 0.9545417
[358] 0.9544607 0.9543792 0.9542972 0.9542147 0.9541318 0.9540484 0.9539644
[365] 0.9538800 0.9537952 0.9537098 0.9536240 0.9535376 0.9534508 0.9533635
[372] 0.9532758 0.9531875 0.9530988 0.9530095 0.9529198 0.9528297 0.9527390
[379] 0.9526478 0.9525562 0.9524641 0.9523715 0.9522785 0.9521849 0.9520909
[386] 0.9519964 0.9519014 0.9518059 0.9517100 0.9516136 0.9515167 0.9514193
[393] 0.9513214 0.9512231 0.9511243 0.9510250 0.9509252 0.9508249 0.9507242
[400] 0.9506230 0.9505213
> mx
[1] 0.9612912
> mxli
[1] -0.12
> 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/1c76p1226141882.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/2et9x1226141882.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/33cm51226141882.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/4d4ud1226141882.tab") 
> 
> system("convert tmp/1c76p1226141882.ps tmp/1c76p1226141882.png")
> system("convert tmp/2et9x1226141882.ps tmp/2et9x1226141882.png")
> system("convert tmp/33cm51226141882.ps tmp/33cm51226141882.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.843   0.809   1.964