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(3269,2934,3098,2956,3429,2887,2587,2865,3645,2557,3120,2827,3530,2606,3015,3481,3011,3179,2899,2768,3498,3417,3317,2951,3911,3674,3505,4263,3729,4384,4110,3360,3450,3708,3515,2877,3810,3953,3226,3818,3295,2884,3190,2652,3388,3071,2545,2686,4085,2869,2719,3599,2912,3509,3533,2365,2606,2712,2551,2646)
> x <- c(1784,1429,1744,1551,1679,1639,1393,1405,1750,1263,1357,1593,1821,1419,1524,1637,1540,1623,1523,1335,1700,1615,1493,1577,1607,1765,1504,1936,1862,2570,2082,1781,1869,1785,1682,1556,2080,2027,1887,1935,1798,1589,1592,1387,1849,1470,1437,1500,2081,1552,1586,1914,1639,1633,1693,1224,1417,1577,1225,1510)
> #'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.8218850 0.8220949 0.8223041 0.8225127 0.8227205 0.8229276 0.8231340
  [8] 0.8233397 0.8235447 0.8237490 0.8239526 0.8241555 0.8243576 0.8245591
 [15] 0.8247598 0.8249598 0.8251591 0.8253576 0.8255554 0.8257525 0.8259488
 [22] 0.8261444 0.8263393 0.8265334 0.8267268 0.8269194 0.8271113 0.8273025
 [29] 0.8274929 0.8276825 0.8278713 0.8280595 0.8282468 0.8284334 0.8286192
 [36] 0.8288043 0.8289885 0.8291720 0.8293548 0.8295367 0.8297179 0.8298982
 [43] 0.8300778 0.8302566 0.8304347 0.8306119 0.8307883 0.8309640 0.8311388
 [50] 0.8313128 0.8314860 0.8316585 0.8318301 0.8320009 0.8321709 0.8323400
 [57] 0.8325084 0.8326759 0.8328426 0.8330085 0.8331735 0.8333378 0.8335012
 [64] 0.8336637 0.8338254 0.8339863 0.8341463 0.8343055 0.8344639 0.8346214
 [71] 0.8347780 0.8349338 0.8350887 0.8352428 0.8353960 0.8355483 0.8356998
 [78] 0.8358504 0.8360002 0.8361490 0.8362970 0.8364441 0.8365904 0.8367357
 [85] 0.8368802 0.8370237 0.8371664 0.8373082 0.8374491 0.8375891 0.8377282
 [92] 0.8378664 0.8380037 0.8381401 0.8382755 0.8384101 0.8385437 0.8386765
 [99] 0.8388083 0.8389392 0.8390691 0.8391982 0.8393263 0.8394534 0.8395797
[106] 0.8397050 0.8398294 0.8399528 0.8400753 0.8401968 0.8403174 0.8404370
[113] 0.8405557 0.8406734 0.8407902 0.8409060 0.8410208 0.8411347 0.8412476
[120] 0.8413596 0.8414705 0.8415805 0.8416896 0.8417976 0.8419046 0.8420107
[127] 0.8421158 0.8422199 0.8423230 0.8424251 0.8425262 0.8426263 0.8427254
[134] 0.8428235 0.8429206 0.8430167 0.8431117 0.8432058 0.8432988 0.8433908
[141] 0.8434818 0.8435718 0.8436608 0.8437487 0.8438356 0.8439214 0.8440063
[148] 0.8440900 0.8441728 0.8442545 0.8443351 0.8444147 0.8444933 0.8445708
[155] 0.8446472 0.8447226 0.8447969 0.8448702 0.8449424 0.8450135 0.8450836
[162] 0.8451526 0.8452205 0.8452873 0.8453531 0.8454178 0.8454814 0.8455439
[169] 0.8456053 0.8456656 0.8457248 0.8457830 0.8458400 0.8458959 0.8459508
[176] 0.8460045 0.8460571 0.8461086 0.8461590 0.8462083 0.8462565 0.8463035
[183] 0.8463494 0.8463942 0.8464379 0.8464804 0.8465218 0.8465621 0.8466013
[190] 0.8466393 0.8466761 0.8467118 0.8467464 0.8467798 0.8468121 0.8468432
[197] 0.8468732 0.8469020 0.8469296 0.8469561 0.8469815 0.8470056 0.8470286
[204] 0.8470504 0.8470711 0.8470905 0.8471088 0.8471260 0.8471419 0.8471566
[211] 0.8471702 0.8471826 0.8471937 0.8472037 0.8472125 0.8472201 0.8472265
[218] 0.8472317 0.8472357 0.8472385 0.8472401 0.8472404 0.8472396 0.8472375
[225] 0.8472342 0.8472297 0.8472240 0.8472171 0.8472089 0.8471995 0.8471889
[232] 0.8471770 0.8471639 0.8471496 0.8471340 0.8471172 0.8470991 0.8470798
[239] 0.8470593 0.8470375 0.8470144 0.8469901 0.8469646 0.8469378 0.8469097
[246] 0.8468804 0.8468498 0.8468179 0.8467848 0.8467504 0.8467147 0.8466778
[253] 0.8466396 0.8466001 0.8465593 0.8465172 0.8464739 0.8464293 0.8463834
[260] 0.8463362 0.8462877 0.8462379 0.8461869 0.8461345 0.8460808 0.8460259
[267] 0.8459696 0.8459120 0.8458532 0.8457930 0.8457315 0.8456687 0.8456046
[274] 0.8455391 0.8454724 0.8454043 0.8453350 0.8452643 0.8451922 0.8451189
[281] 0.8450442 0.8449682 0.8448909 0.8448122 0.8447322 0.8446509 0.8445683
[288] 0.8444843 0.8443989 0.8443122 0.8442242 0.8441348 0.8440441 0.8439521
[295] 0.8438587 0.8437639 0.8436678 0.8435704 0.8434715 0.8433714 0.8432698
[302] 0.8431670 0.8430627 0.8429571 0.8428501 0.8427418 0.8426321 0.8425211
[309] 0.8424086 0.8422948 0.8421796 0.8420631 0.8419452 0.8418259 0.8417052
[316] 0.8415832 0.8414598 0.8413350 0.8412088 0.8410812 0.8409523 0.8408219
[323] 0.8406902 0.8405571 0.8404226 0.8402868 0.8401495 0.8400108 0.8398708
[330] 0.8397294 0.8395865 0.8394423 0.8392967 0.8391497 0.8390012 0.8388514
[337] 0.8387002 0.8385476 0.8383936 0.8382382 0.8380814 0.8379231 0.8377635
[344] 0.8376025 0.8374401 0.8372762 0.8371110 0.8369443 0.8367763 0.8366068
[351] 0.8364359 0.8362636 0.8360899 0.8359148 0.8357383 0.8355604 0.8353810
[358] 0.8352003 0.8350181 0.8348345 0.8346495 0.8344631 0.8342752 0.8340860
[365] 0.8338953 0.8337032 0.8335097 0.8333148 0.8331185 0.8329207 0.8327216
[372] 0.8325210 0.8323190 0.8321155 0.8319107 0.8317044 0.8314968 0.8312877
[379] 0.8310771 0.8308652 0.8306518 0.8304371 0.8302209 0.8300032 0.8297842
[386] 0.8295638 0.8293419 0.8291186 0.8288939 0.8286677 0.8284402 0.8282112
[393] 0.8279808 0.8277490 0.8275158 0.8272812 0.8270451 0.8268077 0.8265688
[400] 0.8263285 0.8260867
> mx
[1] 0.8472404
> mxli
[1] 0.21
> 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/11faq1226487021.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/2xjcz1226487021.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/3akuw1226487021.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/4ihc81226487021.tab") 
> 
> system("convert tmp/11faq1226487021.ps tmp/11faq1226487021.png")
> system("convert tmp/2xjcz1226487021.ps tmp/2xjcz1226487021.png")
> system("convert tmp/3akuw1226487021.ps tmp/3akuw1226487021.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.861   0.841   1.989