R version 2.6.0 (2007-10-03)
Copyright (C) 2007 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(107.97,108.13,108.54,109.86,109.75,109.99,112.01,111.96,111.41,112.11,111.67,111.95,112.31,113.26,113.5,114.43,115.02,115.1,117.11,117.52,116.1,116.39,116.01,116.74,116.68,117.45,117.8,119.37,118.9,119.05,120.46,120.99,119.86,120.18,119.81,120.15,119.8,120.27,120.71,121.87,121.87,121.92,123.72,124.38,123.21,123.17,122.95,123.46,123.24,123.86,124.28,124.78,125.19,125.46,127.6,127.8,126.63,127.06,126.77,127.05)
> x <- c(106.48,106.83,107.14,107.94,108.46,108.81,108.92,108.99,109.16,109.22,109.43,109.23,109.93,110.09,110.33,110.11,110.35,110.09,110.44,110.39,110.62,110.43,110.46,110.55,110.94,111.56,111.82,111.73,111.57,111.85,112.06,112.2,112.47,112.15,112.36,112.32,112.67,113.02,113.05,113.5,113.67,113.65,114,114.03,114.08,114.49,114.48,114.25,114.68,115.28,115.9,115.87,116.09,116.29,116.76,116.78,116.65,116.46,116.82,116.91)
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: Wessa P., (2007), Box-Cox Linearity Plot (v1.0.3) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_boxcoxlin.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description
> 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.9827437 0.9827373 0.9827309 0.9827245 0.9827180 0.9827116 0.9827051
  [8] 0.9826986 0.9826921 0.9826856 0.9826790 0.9826725 0.9826659 0.9826593
 [15] 0.9826527 0.9826460 0.9826394 0.9826327 0.9826260 0.9826193 0.9826125
 [22] 0.9826058 0.9825990 0.9825922 0.9825854 0.9825786 0.9825717 0.9825649
 [29] 0.9825580 0.9825511 0.9825442 0.9825372 0.9825303 0.9825233 0.9825163
 [36] 0.9825093 0.9825022 0.9824952 0.9824881 0.9824810 0.9824739 0.9824668
 [43] 0.9824597 0.9824525 0.9824453 0.9824381 0.9824309 0.9824237 0.9824164
 [50] 0.9824091 0.9824018 0.9823945 0.9823872 0.9823798 0.9823725 0.9823651
 [57] 0.9823577 0.9823503 0.9823428 0.9823354 0.9823279 0.9823204 0.9823129
 [64] 0.9823053 0.9822978 0.9822902 0.9822826 0.9822750 0.9822674 0.9822597
 [71] 0.9822521 0.9822444 0.9822367 0.9822290 0.9822212 0.9822135 0.9822057
 [78] 0.9821979 0.9821901 0.9821822 0.9821744 0.9821665 0.9821586 0.9821507
 [85] 0.9821428 0.9821349 0.9821269 0.9821189 0.9821109 0.9821029 0.9820949
 [92] 0.9820868 0.9820788 0.9820707 0.9820626 0.9820544 0.9820463 0.9820381
 [99] 0.9820300 0.9820218 0.9820135 0.9820053 0.9819970 0.9819888 0.9819805
[106] 0.9819722 0.9819638 0.9819555 0.9819471 0.9819388 0.9819304 0.9819219
[113] 0.9819135 0.9819050 0.9818966 0.9818881 0.9818796 0.9818710 0.9818625
[120] 0.9818539 0.9818453 0.9818367 0.9818281 0.9818195 0.9818108 0.9818021
[127] 0.9817934 0.9817847 0.9817760 0.9817672 0.9817585 0.9817497 0.9817409
[134] 0.9817321 0.9817232 0.9817144 0.9817055 0.9816966 0.9816877 0.9816787
[141] 0.9816698 0.9816608 0.9816518 0.9816428 0.9816338 0.9816248 0.9816157
[148] 0.9816066 0.9815975 0.9815884 0.9815793 0.9815701 0.9815610 0.9815518
[155] 0.9815426 0.9815334 0.9815241 0.9815149 0.9815056 0.9814963 0.9814870
[162] 0.9814776 0.9814683 0.9814589 0.9814495 0.9814401 0.9814307 0.9814213
[169] 0.9814118 0.9814023 0.9813928 0.9813833 0.9813738 0.9813643 0.9813547
[176] 0.9813451 0.9813355 0.9813259 0.9813162 0.9813066 0.9812969 0.9812872
[183] 0.9812775 0.9812678 0.9812580 0.9812483 0.9812385 0.9812287 0.9812189
[190] 0.9812090 0.9811992 0.9811893 0.9811794 0.9811695 0.9811596 0.9811496
[197] 0.9811397 0.9811297 0.9811197 0.9811097 0.9810996 0.9810896 0.9810795
[204] 0.9810694 0.9810593 0.9810492 0.9810390 0.9810289 0.9810187 0.9810085
[211] 0.9809983 0.9809880 0.9809778 0.9809675 0.9809572 0.9809469 0.9809366
[218] 0.9809263 0.9809159 0.9809055 0.9808951 0.9808847 0.9808743 0.9808639
[225] 0.9808534 0.9808429 0.9808324 0.9808219 0.9808114 0.9808008 0.9807902
[232] 0.9807796 0.9807690 0.9807584 0.9807478 0.9807371 0.9807264 0.9807157
[239] 0.9807050 0.9806943 0.9806835 0.9806728 0.9806620 0.9806512 0.9806404
[246] 0.9806295 0.9806187 0.9806078 0.9805969 0.9805860 0.9805751 0.9805641
[253] 0.9805531 0.9805422 0.9805312 0.9805202 0.9805091 0.9804981 0.9804870
[260] 0.9804759 0.9804648 0.9804537 0.9804425 0.9804314 0.9804202 0.9804090
[267] 0.9803978 0.9803866 0.9803753 0.9803641 0.9803528 0.9803415 0.9803302
[274] 0.9803188 0.9803075 0.9802961 0.9802847 0.9802733 0.9802619 0.9802505
[281] 0.9802390 0.9802275 0.9802160 0.9802045 0.9801930 0.9801815 0.9801699
[288] 0.9801583 0.9801467 0.9801351 0.9801235 0.9801118 0.9801001 0.9800885
[295] 0.9800768 0.9800650 0.9800533 0.9800415 0.9800298 0.9800180 0.9800062
[302] 0.9799943 0.9799825 0.9799706 0.9799588 0.9799469 0.9799350 0.9799230
[309] 0.9799111 0.9798991 0.9798871 0.9798751 0.9798631 0.9798511 0.9798390
[316] 0.9798270 0.9798149 0.9798028 0.9797906 0.9797785 0.9797663 0.9797542
[323] 0.9797420 0.9797298 0.9797175 0.9797053 0.9796930 0.9796807 0.9796685
[330] 0.9796561 0.9796438 0.9796315 0.9796191 0.9796067 0.9795943 0.9795819
[337] 0.9795695 0.9795570 0.9795445 0.9795320 0.9795195 0.9795070 0.9794945
[344] 0.9794819 0.9794694 0.9794568 0.9794442 0.9794315 0.9794189 0.9794062
[351] 0.9793935 0.9793809 0.9793681 0.9793554 0.9793427 0.9793299 0.9793171
[358] 0.9793043 0.9792915 0.9792787 0.9792658 0.9792530 0.9792401 0.9792272
[365] 0.9792143 0.9792013 0.9791884 0.9791754 0.9791624 0.9791494 0.9791364
[372] 0.9791233 0.9791103 0.9790972 0.9790841 0.9790710 0.9790579 0.9790448
[379] 0.9790316 0.9790184 0.9790052 0.9789920 0.9789788 0.9789655 0.9789523
[386] 0.9789390 0.9789257 0.9789124 0.9788991 0.9788857 0.9788724 0.9788590
[393] 0.9788456 0.9788322 0.9788187 0.9788053 0.9787918 0.9787783 0.9787648
[400] 0.9787513 0.9787378
> mx
[1] 0.9827437
> 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/1acsd1194190491.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/2x8sc1194190491.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/3z5vk1194190491.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 
> 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/4p8ne1194190492.tab") 
> 
> system("convert tmp/1acsd1194190491.ps tmp/1acsd1194190491.png")
> system("convert tmp/2x8sc1194190491.ps tmp/2x8sc1194190491.png")
> system("convert tmp/3z5vk1194190491.ps tmp/3z5vk1194190491.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.028   0.512   1.166