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(25.5,25.5,25.5,20.9,20.9,20.9,22.3,22.3,22.3,19.9,19.9,19.9,24.1,24.1,24.1,13.8,13.8,13.8,16.2,16.2,16.2,18.6,18.6,18.6,22.4,22.4,22.4,22.6,22.6,22.6,20,20,20,21.8,21.8,21.8,28.7,28.7,28.7,19.5,19.5,19.5,19.4,19.4,19.4,21.7,21.7,21.7,26.2,26.2,26.2,19.1,19.1,19.1,21.3,21.3,21.3,24.1,24.1,24.1)
> x <- c(8.2,8.3,8.1,7.4,7.3,7.7,8,8,7.7,6.9,6.6,6.9,7.5,7.9,7.7,6.5,6.1,6.4,6.8,7.1,7.3,7.2,7,7,7,7.3,7.5,7.2,7.7,8,7.9,8,8,7.9,7.9,8,8.1,8.1,8.2,8,8.3,8.5,8.6,8.7,8.7,8.5,8.4,8.5,8.7,8.7,8.6,7.9,8.1,8.2,8.5,8.6,8.5,8.3,8.2,8.7)
> #'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.5948101 0.5947127 0.5946150 0.5945172 0.5944192 0.5943211 0.5942228
  [8] 0.5941243 0.5940257 0.5939269 0.5938279 0.5937288 0.5936295 0.5935300
 [15] 0.5934304 0.5933306 0.5932306 0.5931305 0.5930302 0.5929298 0.5928292
 [22] 0.5927284 0.5926275 0.5925264 0.5924251 0.5923237 0.5922222 0.5921204
 [29] 0.5920185 0.5919165 0.5918142 0.5917119 0.5916093 0.5915066 0.5914038
 [36] 0.5913008 0.5911976 0.5910942 0.5909907 0.5908871 0.5907833 0.5906793
 [43] 0.5905752 0.5904709 0.5903665 0.5902619 0.5901571 0.5900522 0.5899471
 [50] 0.5898419 0.5897365 0.5896310 0.5895253 0.5894195 0.5893135 0.5892073
 [57] 0.5891010 0.5889945 0.5888879 0.5887812 0.5886742 0.5885672 0.5884599
 [64] 0.5883525 0.5882450 0.5881373 0.5880295 0.5879215 0.5878133 0.5877050
 [71] 0.5875966 0.5874880 0.5873792 0.5872703 0.5871613 0.5870521 0.5869427
 [78] 0.5868332 0.5867236 0.5866138 0.5865039 0.5863938 0.5862835 0.5861731
 [85] 0.5860626 0.5859519 0.5858411 0.5857301 0.5856190 0.5855077 0.5853963
 [92] 0.5852847 0.5851730 0.5850611 0.5849491 0.5848370 0.5847247 0.5846122
 [99] 0.5844996 0.5843869 0.5842740 0.5841610 0.5840479 0.5839346 0.5838211
[106] 0.5837075 0.5835938 0.5834799 0.5833659 0.5832517 0.5831374 0.5830230
[113] 0.5829084 0.5827937 0.5826788 0.5825638 0.5824487 0.5823334 0.5822180
[120] 0.5821024 0.5819867 0.5818709 0.5817549 0.5816388 0.5815225 0.5814061
[127] 0.5812896 0.5811729 0.5810561 0.5809391 0.5808221 0.5807048 0.5805875
[134] 0.5804700 0.5803524 0.5802346 0.5801167 0.5799987 0.5798805 0.5797622
[141] 0.5796438 0.5795252 0.5794065 0.5792876 0.5791687 0.5790496 0.5789303
[148] 0.5788110 0.5786915 0.5785718 0.5784520 0.5783321 0.5782121 0.5780920
[155] 0.5779717 0.5778512 0.5777307 0.5776100 0.5774892 0.5773683 0.5772472
[162] 0.5771260 0.5770046 0.5768832 0.5767616 0.5766399 0.5765180 0.5763961
[169] 0.5762740 0.5761517 0.5760294 0.5759069 0.5757843 0.5756616 0.5755387
[176] 0.5754157 0.5752926 0.5751694 0.5750460 0.5749226 0.5747989 0.5746752
[183] 0.5745514 0.5744274 0.5743033 0.5741791 0.5740547 0.5739302 0.5738056
[190] 0.5736809 0.5735561 0.5734311 0.5733060 0.5731808 0.5730555 0.5729301
[197] 0.5728045 0.5726788 0.5725530 0.5724271 0.5723011 0.5721749 0.5720486
[204] 0.5719222 0.5717957 0.5716691 0.5715423 0.5714154 0.5712884 0.5711613
[211] 0.5710341 0.5709068 0.5707793 0.5706517 0.5705241 0.5703962 0.5702683
[218] 0.5701403 0.5700121 0.5698839 0.5697555 0.5696270 0.5694984 0.5693697
[225] 0.5692408 0.5691119 0.5689828 0.5688537 0.5687244 0.5685950 0.5684655
[232] 0.5683359 0.5682061 0.5680763 0.5679463 0.5678163 0.5676861 0.5675558
[239] 0.5674254 0.5672949 0.5671643 0.5670336 0.5669027 0.5667718 0.5666408
[246] 0.5665096 0.5663783 0.5662470 0.5661155 0.5659839 0.5658522 0.5657204
[253] 0.5655885 0.5654565 0.5653244 0.5651921 0.5650598 0.5649274 0.5647948
[260] 0.5646622 0.5645295 0.5643966 0.5642637 0.5641306 0.5639974 0.5638642
[267] 0.5637308 0.5635973 0.5634638 0.5633301 0.5631963 0.5630624 0.5629284
[274] 0.5627944 0.5626602 0.5625259 0.5623915 0.5622570 0.5621225 0.5619878
[281] 0.5618530 0.5617181 0.5615831 0.5614481 0.5613129 0.5611776 0.5610422
[288] 0.5609068 0.5607712 0.5606355 0.5604998 0.5603639 0.5602280 0.5600919
[295] 0.5599558 0.5598195 0.5596832 0.5595468 0.5594102 0.5592736 0.5591369
[302] 0.5590001 0.5588632 0.5587262 0.5585891 0.5584519 0.5583147 0.5581773
[309] 0.5580398 0.5579023 0.5577646 0.5576269 0.5574891 0.5573511 0.5572131
[316] 0.5570750 0.5569368 0.5567986 0.5566602 0.5565217 0.5563832 0.5562446
[323] 0.5561058 0.5559670 0.5558281 0.5556891 0.5555500 0.5554109 0.5552716
[330] 0.5551323 0.5549928 0.5548533 0.5547137 0.5545740 0.5544343 0.5542944
[337] 0.5541545 0.5540144 0.5538743 0.5537341 0.5535938 0.5534535 0.5533130
[344] 0.5531725 0.5530319 0.5528912 0.5527504 0.5526095 0.5524686 0.5523275
[351] 0.5521864 0.5520452 0.5519039 0.5517626 0.5516211 0.5514796 0.5513380
[358] 0.5511963 0.5510546 0.5509127 0.5507708 0.5506288 0.5504867 0.5503446
[365] 0.5502023 0.5500600 0.5499176 0.5497752 0.5496326 0.5494900 0.5493473
[372] 0.5492045 0.5490616 0.5489187 0.5487757 0.5486326 0.5484895 0.5483462
[379] 0.5482029 0.5480595 0.5479161 0.5477725 0.5476289 0.5474852 0.5473415
[386] 0.5471977 0.5470538 0.5469098 0.5467657 0.5466216 0.5464774 0.5463331
[393] 0.5461888 0.5460444 0.5458999 0.5457554 0.5456107 0.5454660 0.5453213
[400] 0.5451764 0.5450315
> mx
[1] 0.5948101
> 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/1k78l1257942655.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/2ghbx1257942655.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/3qx9v1257942655.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/4l3ke1257942655.tab") 
> 
> system("convert tmp/1k78l1257942655.ps tmp/1k78l1257942655.png")
> system("convert tmp/2ghbx1257942655.ps tmp/2ghbx1257942655.png")
> system("convert tmp/3qx9v1257942655.ps tmp/3qx9v1257942655.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.772   0.482   1.208