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(16283.6,16726.5,14968.9,14861,14583.3,15305.8,17903.9,16379.4,15420.3,17870.5,15912.8,13866.5,17823.2,17872,17420.4,16704.4,15991.2,16583.6,19123.5,17838.7,17209.4,18586.5,16258.1,15141.6,19202.1,17746.5,19090.1,18040.3,17515.5,17751.8,21072.4,17170,19439.5,19795.4,17574.9,16165.4,19464.6,19932.1,19961.2,17343.4,18924.2,18574.1,21350.6,18594.6,19823.1,20844.4,19640.2,17735.4,19813.6,22160,20664.3,17877.4,20906.5,21164.1,21374.4,22952.3,21343.5,23899.3,22392.9,18274.1,22786.7,22321.5)
> x <- c(109.8,111.7,98.6,96.9,95.1,97,112.7,102.9,97.4,111.4,87.4,96.8,114.1,110.3,103.9,101.6,94.6,95.9,104.7,102.8,98.1,113.9,80.9,95.7,113.2,105.9,108.8,102.3,99,100.7,115.5,100.7,109.9,114.6,85.4,100.5,114.8,116.5,112.9,102,106,105.3,118.8,106.1,109.3,117.2,92.5,104.2,112.5,122.4,113.3,100,110.7,112.8,109.8,117.3,109.1,115.9,96,99.8,116.8,115.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.6291724 0.6294013 0.6296298 0.6298582 0.6300862 0.6303139 0.6305413
  [8] 0.6307685 0.6309954 0.6312219 0.6314482 0.6316742 0.6318999 0.6321253
 [15] 0.6323504 0.6325753 0.6327998 0.6330241 0.6332480 0.6334717 0.6336951
 [22] 0.6339182 0.6341409 0.6343634 0.6345857 0.6348076 0.6350292 0.6352505
 [29] 0.6354716 0.6356923 0.6359128 0.6361329 0.6363528 0.6365724 0.6367917
 [36] 0.6370107 0.6372293 0.6374477 0.6376659 0.6378837 0.6381012 0.6383184
 [43] 0.6385354 0.6387520 0.6389683 0.6391844 0.6394001 0.6396156 0.6398308
 [50] 0.6400456 0.6402602 0.6404745 0.6406885 0.6409022 0.6411156 0.6413287
 [57] 0.6415415 0.6417540 0.6419662 0.6421781 0.6423897 0.6426011 0.6428121
 [64] 0.6430228 0.6432333 0.6434434 0.6436533 0.6438628 0.6440721 0.6442810
 [71] 0.6444897 0.6446980 0.6449061 0.6451139 0.6453213 0.6455285 0.6457354
 [78] 0.6459420 0.6461483 0.6463543 0.6465600 0.6467653 0.6469704 0.6471752
 [85] 0.6473797 0.6475840 0.6477879 0.6479915 0.6481948 0.6483978 0.6486005
 [92] 0.6488029 0.6490051 0.6492069 0.6494084 0.6496097 0.6498106 0.6500112
 [99] 0.6502116 0.6504116 0.6506113 0.6508108 0.6510099 0.6512088 0.6514073
[106] 0.6516056 0.6518035 0.6520012 0.6521986 0.6523956 0.6525924 0.6527889
[113] 0.6529850 0.6531809 0.6533765 0.6535717 0.6537667 0.6539614 0.6541558
[120] 0.6543499 0.6545436 0.6547371 0.6549303 0.6551232 0.6553158 0.6555081
[127] 0.6557001 0.6558918 0.6560832 0.6562743 0.6564651 0.6566556 0.6568459
[134] 0.6570358 0.6572254 0.6574147 0.6576037 0.6577925 0.6579809 0.6581690
[141] 0.6583568 0.6585444 0.6587316 0.6589186 0.6591052 0.6592915 0.6594776
[148] 0.6596633 0.6598488 0.6600340 0.6602188 0.6604034 0.6605876 0.6607716
[155] 0.6609553 0.6611387 0.6613217 0.6615045 0.6616870 0.6618692 0.6620511
[162] 0.6622327 0.6624140 0.6625950 0.6627757 0.6629561 0.6631362 0.6633161
[169] 0.6634956 0.6636748 0.6638537 0.6640324 0.6642107 0.6643888 0.6645665
[176] 0.6647440 0.6649211 0.6650980 0.6652746 0.6654508 0.6656268 0.6658025
[183] 0.6659779 0.6661530 0.6663278 0.6665023 0.6666765 0.6668504 0.6670240
[190] 0.6671974 0.6673704 0.6675431 0.6677156 0.6678877 0.6680596 0.6682311
[197] 0.6684024 0.6685734 0.6687441 0.6689145 0.6690846 0.6692544 0.6694239
[204] 0.6695931 0.6697620 0.6699306 0.6700990 0.6702670 0.6704348 0.6706022
[211] 0.6707694 0.6709363 0.6711029 0.6712692 0.6714352 0.6716009 0.6717663
[218] 0.6719314 0.6720963 0.6722608 0.6724251 0.6725890 0.6727527 0.6729161
[225] 0.6730792 0.6732420 0.6734045 0.6735667 0.6737286 0.6738903 0.6740516
[232] 0.6742127 0.6743735 0.6745340 0.6746942 0.6748541 0.6750137 0.6751730
[239] 0.6753320 0.6754908 0.6756493 0.6758074 0.6759653 0.6761229 0.6762802
[246] 0.6764373 0.6765940 0.6767504 0.6769066 0.6770625 0.6772181 0.6773734
[253] 0.6775284 0.6776831 0.6778375 0.6779917 0.6781456 0.6782991 0.6784524
[260] 0.6786055 0.6787582 0.6789106 0.6790628 0.6792147 0.6793662 0.6795175
[267] 0.6796686 0.6798193 0.6799697 0.6801199 0.6802698 0.6804194 0.6805687
[274] 0.6807177 0.6808665 0.6810149 0.6811631 0.6813110 0.6814586 0.6816060
[281] 0.6817530 0.6818998 0.6820463 0.6821925 0.6823384 0.6824841 0.6826294
[288] 0.6827745 0.6829193 0.6830638 0.6832081 0.6833520 0.6834957 0.6836391
[295] 0.6837822 0.6839251 0.6840676 0.6842099 0.6843519 0.6844936 0.6846351
[302] 0.6847763 0.6849171 0.6850578 0.6851981 0.6853381 0.6854779 0.6856174
[309] 0.6857567 0.6858956 0.6860343 0.6861727 0.6863108 0.6864486 0.6865862
[316] 0.6867235 0.6868605 0.6869972 0.6871337 0.6872699 0.6874058 0.6875414
[323] 0.6876768 0.6878119 0.6879467 0.6880812 0.6882155 0.6883495 0.6884832
[330] 0.6886167 0.6887499 0.6888828 0.6890154 0.6891478 0.6892798 0.6894117
[337] 0.6895432 0.6896745 0.6898055 0.6899362 0.6900667 0.6901968 0.6903268
[344] 0.6904564 0.6905858 0.6907149 0.6908437 0.6909723 0.6911006 0.6912286
[351] 0.6913564 0.6914839 0.6916111 0.6917381 0.6918647 0.6919912 0.6921173
[358] 0.6922432 0.6923688 0.6924942 0.6926193 0.6927441 0.6928686 0.6929929
[365] 0.6931169 0.6932407 0.6933642 0.6934874 0.6936103 0.6937330 0.6938555
[372] 0.6939776 0.6940995 0.6942212 0.6943425 0.6944637 0.6945845 0.6947051
[379] 0.6948254 0.6949455 0.6950653 0.6951848 0.6953041 0.6954231 0.6955418
[386] 0.6956603 0.6957785 0.6958965 0.6960142 0.6961316 0.6962488 0.6963657
[393] 0.6964824 0.6965988 0.6967149 0.6968308 0.6969465 0.6970618 0.6971769
[400] 0.6972918 0.6974064
> mx
[1] 0.6974064
> 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/1pimv1258145622.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/2fiw51258145622.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/30nvr1258145622.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/476fn1258145622.tab") 
> 
> system("convert tmp/1pimv1258145622.ps tmp/1pimv1258145622.png")
> system("convert tmp/2fiw51258145622.ps tmp/2fiw51258145622.png")
> system("convert tmp/30nvr1258145622.ps tmp/30nvr1258145622.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.767   0.572   0.950