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(37.2,37.2,34.7,32.5,33.5,31.5,31.2,27,26.7,26.5,26,27.2,30.5,33.7,34.2,36.7,36.2,38.5,40,42.5,43.5,43.3,45.5,44.3,43,43.5,41.5,42.5,41.3,39.5,38.5,41,44.5,46,44,41.5,41.3,38,38,36.2,38.7,38.7,39.2,35.7,36.5,36.7,34.7,35,28.2,23.7,15,8.7,11,7.5,5.7,9.3,10.2,15.7,18.1,20.8)
> x <- c(115.6,111.9,107,107.1,100.6,99.2,108.4,103,99.8,115,90.8,95.9,114.4,108.2,112.6,109.1,105,105,118.5,103.7,112.5,116.6,96.6,101.9,116.5,119.3,115.4,108.5,111.5,108.8,121.8,109.6,112.2,119.6,104.1,105.3,115,124.1,116.8,107.5,115.6,116.2,116.3,119,111.9,118.6,106.9,103.2,118.6,118.7,102.8,100.6,94.9,94.5,102.9,95.3,92.5,102.7,91.5,89.5)
> #'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.6024628 0.6024133 0.6023637 0.6023140 0.6022641 0.6022140 0.6021638
  [8] 0.6021134 0.6020629 0.6020122 0.6019613 0.6019103 0.6018591 0.6018078
 [15] 0.6017564 0.6017047 0.6016530 0.6016010 0.6015489 0.6014967 0.6014443
 [22] 0.6013917 0.6013390 0.6012862 0.6012332 0.6011800 0.6011267 0.6010732
 [29] 0.6010196 0.6009658 0.6009118 0.6008577 0.6008035 0.6007491 0.6006945
 [36] 0.6006398 0.6005849 0.6005299 0.6004748 0.6004194 0.6003640 0.6003083
 [43] 0.6002525 0.6001966 0.6001405 0.6000843 0.6000279 0.5999713 0.5999146
 [50] 0.5998578 0.5998008 0.5997436 0.5996863 0.5996288 0.5995712 0.5995135
 [57] 0.5994555 0.5993975 0.5993393 0.5992809 0.5992224 0.5991637 0.5991048
 [64] 0.5990459 0.5989867 0.5989275 0.5988680 0.5988084 0.5987487 0.5986888
 [71] 0.5986288 0.5985686 0.5985083 0.5984478 0.5983871 0.5983263 0.5982654
 [78] 0.5982043 0.5981431 0.5980817 0.5980201 0.5979584 0.5978966 0.5978346
 [85] 0.5977725 0.5977102 0.5976478 0.5975852 0.5975224 0.5974596 0.5973965
 [92] 0.5973333 0.5972700 0.5972065 0.5971429 0.5970791 0.5970152 0.5969511
 [99] 0.5968869 0.5968225 0.5967580 0.5966934 0.5966285 0.5965636 0.5964985
[106] 0.5964332 0.5963678 0.5963023 0.5962366 0.5961707 0.5961047 0.5960386
[113] 0.5959723 0.5959059 0.5958393 0.5957726 0.5957057 0.5956387 0.5955715
[120] 0.5955042 0.5954368 0.5953692 0.5953014 0.5952335 0.5951655 0.5950973
[127] 0.5950290 0.5949605 0.5948919 0.5948231 0.5947542 0.5946852 0.5946160
[134] 0.5945466 0.5944772 0.5944075 0.5943378 0.5942678 0.5941978 0.5941276
[141] 0.5940572 0.5939867 0.5939161 0.5938453 0.5937744 0.5937033 0.5936321
[148] 0.5935608 0.5934893 0.5934176 0.5933458 0.5932739 0.5932019 0.5931296
[155] 0.5930573 0.5929848 0.5929122 0.5928394 0.5927665 0.5926934 0.5926202
[162] 0.5925469 0.5924734 0.5923998 0.5923260 0.5922521 0.5921781 0.5921039
[169] 0.5920295 0.5919551 0.5918805 0.5918057 0.5917308 0.5916558 0.5915806
[176] 0.5915053 0.5914299 0.5913543 0.5912786 0.5912027 0.5911267 0.5910506
[183] 0.5909743 0.5908979 0.5908213 0.5907446 0.5906678 0.5905908 0.5905137
[190] 0.5904364 0.5903590 0.5902815 0.5902039 0.5901261 0.5900481 0.5899700
[197] 0.5898918 0.5898135 0.5897350 0.5896564 0.5895776 0.5894987 0.5894197
[204] 0.5893405 0.5892612 0.5891818 0.5891022 0.5890225 0.5889427 0.5888627
[211] 0.5887826 0.5887023 0.5886219 0.5885414 0.5884608 0.5883800 0.5882991
[218] 0.5882180 0.5881368 0.5880555 0.5879740 0.5878924 0.5878107 0.5877288
[225] 0.5876468 0.5875647 0.5874825 0.5874001 0.5873175 0.5872349 0.5871521
[232] 0.5870692 0.5869861 0.5869029 0.5868196 0.5867362 0.5866526 0.5865689
[239] 0.5864850 0.5864011 0.5863169 0.5862327 0.5861483 0.5860638 0.5859792
[246] 0.5858944 0.5858096 0.5857245 0.5856394 0.5855541 0.5854687 0.5853832
[253] 0.5852975 0.5852117 0.5851258 0.5850397 0.5849535 0.5848672 0.5847808
[260] 0.5846942 0.5846075 0.5845207 0.5844337 0.5843466 0.5842594 0.5841721
[267] 0.5840846 0.5839970 0.5839093 0.5838215 0.5837335 0.5836454 0.5835572
[274] 0.5834688 0.5833803 0.5832917 0.5832030 0.5831141 0.5830251 0.5829360
[281] 0.5828468 0.5827574 0.5826680 0.5825784 0.5824886 0.5823988 0.5823088
[288] 0.5822187 0.5821284 0.5820381 0.5819476 0.5818570 0.5817663 0.5816754
[295] 0.5815845 0.5814934 0.5814021 0.5813108 0.5812193 0.5811278 0.5810361
[302] 0.5809442 0.5808523 0.5807602 0.5806680 0.5805757 0.5804832 0.5803907
[309] 0.5802980 0.5802052 0.5801123 0.5800192 0.5799261 0.5798328 0.5797394
[316] 0.5796459 0.5795522 0.5794584 0.5793646 0.5792706 0.5791764 0.5790822
[323] 0.5789878 0.5788934 0.5787988 0.5787040 0.5786092 0.5785143 0.5784192
[330] 0.5783240 0.5782287 0.5781333 0.5780377 0.5779421 0.5778463 0.5777504
[337] 0.5776544 0.5775583 0.5774620 0.5773657 0.5772692 0.5771726 0.5770759
[344] 0.5769791 0.5768822 0.5767851 0.5766879 0.5765907 0.5764933 0.5763957
[351] 0.5762981 0.5762004 0.5761025 0.5760046 0.5759065 0.5758083 0.5757100
[358] 0.5756116 0.5755130 0.5754144 0.5753156 0.5752167 0.5751177 0.5750186
[365] 0.5749194 0.5748201 0.5747207 0.5746211 0.5745215 0.5744217 0.5743218
[372] 0.5742218 0.5741217 0.5740215 0.5739212 0.5738208 0.5737202 0.5736196
[379] 0.5735188 0.5734179 0.5733169 0.5732158 0.5731146 0.5730133 0.5729119
[386] 0.5728104 0.5727087 0.5726070 0.5725051 0.5724032 0.5723011 0.5721989
[393] 0.5720966 0.5719943 0.5718918 0.5717891 0.5716864 0.5715836 0.5714807
[400] 0.5713776 0.5712745
> mx
[1] 0.6024628
> 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/1qg021258139975.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/2pde91258139975.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/3w9291258139975.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/46bp61258139975.tab") 
> 
> system("convert tmp/1qg021258139975.ps tmp/1qg021258139975.png")
> system("convert tmp/2pde91258139975.ps tmp/2pde91258139975.png")
> system("convert tmp/3w9291258139975.ps tmp/3w9291258139975.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.786   0.510   0.927