R version 2.9.0 (2009-04-17)
Copyright (C) 2009 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(492865,480961,461935,456608,441977,439148,488180,520564,501492,485025,464196,460170,467037,460070,447988,442867,436087,431328,484015,509673,512927,502831,470984,471067,476049,474605,470439,461251,454724,455626,516847,525192,522975,518585,509239,512238,519164,517009,509933,509127,500857,506971,569323,579714,577992,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)
> x <- c(344744,338653,327532,326225,318672,317756,337302,349420,336923,330758,321002,320820,327032,324047,316735,315710,313427,310527,330962,339015,341332,339092,323308,325849,330675,332225,331735,328047,326165,327081,346764,344190,343333,345777,344094,348609,354846,356427,353467,355996,352487,355178,374556,375021,375787,372720,364431,370490,376974,377632,378205,370861,369167,371551,382842,381903,384502,392058,384359,388884,386586,387495,385705,378670,377367,376911,389827,387820,387267,380575,372402,376740)
> 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.9640974 0.9641295 0.9641592 0.9641925 0.9642239 0.9642504 0.9642821
  [8] 0.9643125 0.9643441 0.9643727 0.9644044 0.9644337 0.9644640 0.9644946
 [15] 0.9645241 0.9645543 0.9645840 0.9646136 0.9646427 0.9646725 0.9647022
 [22] 0.9647316 0.9647614 0.9647904 0.9648195 0.9648489 0.9648779 0.9649070
 [29] 0.9649360 0.9649648 0.9649937 0.9650225 0.9650512 0.9650799 0.9651084
 [36] 0.9651370 0.9651654 0.9651938 0.9652221 0.9652504 0.9652785 0.9653067
 [43] 0.9653347 0.9653627 0.9653906 0.9654184 0.9654462 0.9654739 0.9655016
 [50] 0.9655292 0.9655567 0.9655841 0.9656115 0.9656388 0.9656661 0.9656933
 [57] 0.9657204 0.9657474 0.9657744 0.9658013 0.9658282 0.9658549 0.9658817
 [64] 0.9659083 0.9659349 0.9659614 0.9659878 0.9660142 0.9660405 0.9660668
 [71] 0.9660930 0.9661191 0.9661451 0.9661711 0.9661970 0.9662229 0.9662486
 [78] 0.9662744 0.9663000 0.9663256 0.9663511 0.9663766 0.9664019 0.9664273
 [85] 0.9664525 0.9664777 0.9665028 0.9665279 0.9665528 0.9665778 0.9666026
 [92] 0.9666274 0.9666521 0.9666768 0.9667013 0.9667259 0.9667503 0.9667747
 [99] 0.9667990 0.9668233 0.9668475 0.9668716 0.9668956 0.9669196 0.9669436
[106] 0.9669674 0.9669912 0.9670149 0.9670386 0.9670622 0.9670857 0.9671092
[113] 0.9671325 0.9671559 0.9671791 0.9672023 0.9672255 0.9672485 0.9672715
[120] 0.9672944 0.9673173 0.9673401 0.9673628 0.9673855 0.9674081 0.9674306
[127] 0.9674531 0.9674755 0.9674978 0.9675201 0.9675423 0.9675644 0.9675865
[134] 0.9676085 0.9676305 0.9676523 0.9676741 0.9676959 0.9677176 0.9677392
[141] 0.9677607 0.9677822 0.9678036 0.9678250 0.9678462 0.9678675 0.9678886
[148] 0.9679097 0.9679307 0.9679517 0.9679725 0.9679934 0.9680141 0.9680348
[155] 0.9680554 0.9680760 0.9680965 0.9681169 0.9681373 0.9681576 0.9681778
[162] 0.9681980 0.9682181 0.9682381 0.9682581 0.9682780 0.9682978 0.9683176
[169] 0.9683373 0.9683569 0.9683765 0.9683960 0.9684155 0.9684348 0.9684542
[176] 0.9684734 0.9684926 0.9685117 0.9685308 0.9685498 0.9685687 0.9685875
[183] 0.9686063 0.9686251 0.9686437 0.9686623 0.9686808 0.9686993 0.9687177
[190] 0.9687360 0.9687543 0.9687725 0.9687907 0.9688087 0.9688267 0.9688447
[197] 0.9688626 0.9688804 0.9688981 0.9689158 0.9689334 0.9689510 0.9689685
[204] 0.9689859 0.9690033 0.9690206 0.9690378 0.9690550 0.9690721 0.9690891
[211] 0.9691061 0.9691230 0.9691398 0.9691566 0.9691733 0.9691900 0.9692065
[218] 0.9692231 0.9692395 0.9692559 0.9692722 0.9692885 0.9693047 0.9693208
[225] 0.9693369 0.9693529 0.9693688 0.9693847 0.9694005 0.9694162 0.9694319
[232] 0.9694475 0.9694631 0.9694786 0.9694940 0.9695094 0.9695246 0.9695399
[239] 0.9695550 0.9695701 0.9695852 0.9696001 0.9696151 0.9696299 0.9696447
[246] 0.9696594 0.9696740 0.9696886 0.9697031 0.9697176 0.9697320 0.9697463
[253] 0.9697606 0.9697748 0.9697889 0.9698030 0.9698170 0.9698310 0.9698449
[260] 0.9698587 0.9698724 0.9698861 0.9698997 0.9699133 0.9699268 0.9699402
[267] 0.9699536 0.9699669 0.9699802 0.9699933 0.9700065 0.9700195 0.9700325
[274] 0.9700454 0.9700583 0.9700711 0.9700838 0.9700965 0.9701091 0.9701216
[281] 0.9701341 0.9701465 0.9701589 0.9701712 0.9701834 0.9701956 0.9702077
[288] 0.9702197 0.9702317 0.9702436 0.9702555 0.9702672 0.9702790 0.9702906
[295] 0.9703022 0.9703137 0.9703252 0.9703366 0.9703480 0.9703592 0.9703705
[302] 0.9703816 0.9703927 0.9704037 0.9704147 0.9704256 0.9704364 0.9704472
[309] 0.9704579 0.9704686 0.9704791 0.9704897 0.9705001 0.9705105 0.9705209
[316] 0.9705311 0.9705413 0.9705515 0.9705616 0.9705716 0.9705816 0.9705915
[323] 0.9706013 0.9706111 0.9706208 0.9706304 0.9706400 0.9706495 0.9706590
[330] 0.9706684 0.9706777 0.9706870 0.9706962 0.9707053 0.9707144 0.9707234
[337] 0.9707324 0.9707413 0.9707501 0.9707589 0.9707676 0.9707763 0.9707849
[344] 0.9707934 0.9708018 0.9708102 0.9708186 0.9708269 0.9708351 0.9708432
[351] 0.9708513 0.9708594 0.9708673 0.9708752 0.9708831 0.9708909 0.9708986
[358] 0.9709062 0.9709138 0.9709214 0.9709288 0.9709362 0.9709436 0.9709509
[365] 0.9709581 0.9709653 0.9709724 0.9709794 0.9709864 0.9709933 0.9710002
[372] 0.9710070 0.9710137 0.9710204 0.9710270 0.9710335 0.9710400 0.9710465
[379] 0.9710528 0.9710591 0.9710654 0.9710716 0.9710777 0.9710837 0.9710897
[386] 0.9710957 0.9711016 0.9711074 0.9711131 0.9711188 0.9711245 0.9711300
[393] 0.9711355 0.9711410 0.9711464 0.9711517 0.9711570 0.9711622 0.9711673
[400] 0.9711724 0.9711775
> mx
[1] 0.9711775
> mxli
[1] 2
> 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/1g5b71257872960.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/2ovuh1257872960.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/322y21257872960.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/4utcu1257872960.tab") 
> 
> system("convert tmp/1g5b71257872960.ps tmp/1g5b71257872960.png")
> system("convert tmp/2ovuh1257872960.ps tmp/2ovuh1257872960.png")
> system("convert tmp/322y21257872960.ps tmp/322y21257872960.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.802   0.500   4.489