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(57.42,56.12,59.15,63.77,63.96,57.81,55.3,51.8,53.26,53.38,45.85,44.23,40.22,44.61,49.14,42.94,41.84,37.75,35.54,37.13,33.19,32.67,30.52,30.7,29.59,28.76,29.08,26.95,29.58,28.24,27.28,25.48,24.87,29.87,32.33,30.23,27.46,24.46,27.34,28.37,26.09,25.59,24.67,25.61,25.97,24.31,20.36,19.82,19.32,19.2,21.74,26.29,25.9,25.36,27.64,28.57,25.38,25.71,27.6,25.85,26.54)
> x <- c(13812,13031,12574,11964,11451,11346,11353,10702,10646,10556,10463,10407,10625,10872,10805,10653,10574,10431,10383,10296,10872,10635,10297,10570,10662,10709,10413,10846,10371,9924,9828,9897,9721,10171,10738,10812,10511,10244,10368,10457,10186,10166,10827,10997,10940,10756,10893,10236,9960,10018,10063,10002,9728,10002,10177,9948,9394,9308,9155,9103,9732)
> #'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.6733714 0.6734794 0.6735871 0.6736944 0.6738014 0.6739079 0.6740141
  [8] 0.6741199 0.6742253 0.6743303 0.6744349 0.6745392 0.6746431 0.6747465
 [15] 0.6748496 0.6749523 0.6750546 0.6751566 0.6752581 0.6753592 0.6754600
 [22] 0.6755604 0.6756603 0.6757599 0.6758591 0.6759579 0.6760563 0.6761543
 [29] 0.6762519 0.6763491 0.6764459 0.6765424 0.6766384 0.6767340 0.6768292
 [36] 0.6769240 0.6770185 0.6771125 0.6772061 0.6772994 0.6773922 0.6774846
 [43] 0.6775766 0.6776682 0.6777594 0.6778502 0.6779406 0.6780306 0.6781202
 [50] 0.6782094 0.6782981 0.6783865 0.6784745 0.6785620 0.6786491 0.6787359
 [57] 0.6788222 0.6789081 0.6789936 0.6790786 0.6791633 0.6792476 0.6793314
 [64] 0.6794148 0.6794978 0.6795804 0.6796626 0.6797443 0.6798257 0.6799066
 [71] 0.6799871 0.6800672 0.6801469 0.6802261 0.6803049 0.6803834 0.6804613
 [78] 0.6805389 0.6806160 0.6806928 0.6807691 0.6808449 0.6809204 0.6809954
 [85] 0.6810700 0.6811442 0.6812179 0.6812912 0.6813641 0.6814366 0.6815086
 [92] 0.6815802 0.6816514 0.6817222 0.6817925 0.6818624 0.6819318 0.6820009
 [99] 0.6820694 0.6821376 0.6822053 0.6822726 0.6823395 0.6824059 0.6824719
[106] 0.6825375 0.6826026 0.6826673 0.6827315 0.6827954 0.6828587 0.6829217
[113] 0.6829842 0.6830462 0.6831079 0.6831691 0.6832298 0.6832901 0.6833500
[120] 0.6834094 0.6834684 0.6835269 0.6835850 0.6836427 0.6836999 0.6837567
[127] 0.6838130 0.6838689 0.6839243 0.6839793 0.6840338 0.6840880 0.6841416
[134] 0.6841948 0.6842476 0.6842999 0.6843518 0.6844032 0.6844541 0.6845047
[141] 0.6845547 0.6846044 0.6846535 0.6847023 0.6847505 0.6847984 0.6848457
[148] 0.6848926 0.6849391 0.6849851 0.6850307 0.6850758 0.6851204 0.6851646
[155] 0.6852084 0.6852517 0.6852945 0.6853369 0.6853788 0.6854203 0.6854613
[162] 0.6855019 0.6855420 0.6855816 0.6856208 0.6856595 0.6856978 0.6857356
[169] 0.6857730 0.6858099 0.6858463 0.6858823 0.6859178 0.6859529 0.6859875
[176] 0.6860216 0.6860553 0.6860885 0.6861213 0.6861536 0.6861854 0.6862168
[183] 0.6862477 0.6862781 0.6863081 0.6863376 0.6863667 0.6863953 0.6864234
[190] 0.6864511 0.6864782 0.6865050 0.6865313 0.6865571 0.6865824 0.6866073
[197] 0.6866317 0.6866556 0.6866791 0.6867021 0.6867246 0.6867467 0.6867683
[204] 0.6867895 0.6868101 0.6868303 0.6868501 0.6868693 0.6868881 0.6869065
[211] 0.6869243 0.6869417 0.6869586 0.6869751 0.6869911 0.6870066 0.6870216
[218] 0.6870362 0.6870503 0.6870640 0.6870771 0.6870898 0.6871020 0.6871138
[225] 0.6871251 0.6871359 0.6871462 0.6871561 0.6871655 0.6871744 0.6871829
[232] 0.6871908 0.6871983 0.6872054 0.6872119 0.6872180 0.6872236 0.6872288
[239] 0.6872335 0.6872377 0.6872414 0.6872446 0.6872474 0.6872497 0.6872515
[246] 0.6872529 0.6872538 0.6872542 0.6872541 0.6872536 0.6872526 0.6872511
[253] 0.6872491 0.6872467 0.6872438 0.6872404 0.6872365 0.6872322 0.6872274
[260] 0.6872221 0.6872164 0.6872101 0.6872034 0.6871962 0.6871886 0.6871804
[267] 0.6871718 0.6871628 0.6871532 0.6871432 0.6871327 0.6871217 0.6871102
[274] 0.6870983 0.6870859 0.6870730 0.6870596 0.6870458 0.6870315 0.6870167
[281] 0.6870015 0.6869857 0.6869695 0.6869528 0.6869357 0.6869180 0.6868999
[288] 0.6868814 0.6868623 0.6868428 0.6868228 0.6868023 0.6867813 0.6867599
[295] 0.6867380 0.6867156 0.6866927 0.6866694 0.6866456 0.6866213 0.6865966
[302] 0.6865713 0.6865456 0.6865195 0.6864928 0.6864657 0.6864381 0.6864100
[309] 0.6863815 0.6863525 0.6863230 0.6862930 0.6862626 0.6862316 0.6862003
[316] 0.6861684 0.6861361 0.6861033 0.6860700 0.6860362 0.6860020 0.6859673
[323] 0.6859322 0.6858965 0.6858604 0.6858238 0.6857868 0.6857493 0.6857113
[330] 0.6856728 0.6856339 0.6855944 0.6855546 0.6855142 0.6854734 0.6854321
[337] 0.6853904 0.6853481 0.6853054 0.6852623 0.6852186 0.6851745 0.6851299
[344] 0.6850849 0.6850394 0.6849934 0.6849470 0.6849000 0.6848527 0.6848048
[351] 0.6847565 0.6847077 0.6846584 0.6846087 0.6845585 0.6845079 0.6844568
[358] 0.6844052 0.6843532 0.6843006 0.6842477 0.6841942 0.6841403 0.6840859
[365] 0.6840311 0.6839758 0.6839200 0.6838638 0.6838071 0.6837500 0.6836924
[372] 0.6836343 0.6835758 0.6835168 0.6834573 0.6833974 0.6833370 0.6832762
[379] 0.6832149 0.6831531 0.6830909 0.6830282 0.6829651 0.6829015 0.6828374
[386] 0.6827729 0.6827079 0.6826425 0.6825766 0.6825103 0.6824435 0.6823762
[393] 0.6823085 0.6822404 0.6821717 0.6821027 0.6820331 0.6819632 0.6818927
[400] 0.6818218 0.6817505
> mx
[1] 0.6872542
> mxli
[1] 0.47
> 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/1236u1226413738.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/2ugw61226413738.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/3kahe1226413738.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/4idsg1226413738.tab") 
> 
> system("convert tmp/1236u1226413738.ps tmp/1236u1226413738.png")
> system("convert tmp/2ugw61226413738.ps tmp/2ugw61226413738.png")
> system("convert tmp/3kahe1226413738.ps tmp/3kahe1226413738.png")
> 
> 
> proc.time()
   user  system elapsed 
  3.396   1.420   3.569