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(1867,1864,1853,1866,1852,1823,1862,1859,1855,1871,1822,1865,1922,1960,1978,1975,1953,1931,1922,1904,1927,1943,1937,1960,1955,1958,1953,1983,1985,1980,1975,1961,1996,2008,2016,2025,2118,2111,2137,2110,2131,2111,2132,2140,2143,2139,2101,2089,2127,2084,1980,2001,1944,1783,1832,1827,1806,1818,1798,1824,1834,1851,1813,1788,1737,1699,1724,1686,1686,1682,1698,1742)
> x <- c(519,517,510,509,501,507,569,580,578,565,547,555,562,561,555,544,537,543,594,611,613,611,594,595,591,589,584,573,567,569,621,629,628,612,595,597,593,590,580,574,573,573,620,626,620,588,566,557,561,549,532,526,511,499,555,565,542,527,510,514,517,508,493,490,469,478,528,534,518,506,502,516)
> #'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.6824771 0.6824556 0.6824340 0.6824123 0.6823904 0.6823685 0.6823464
  [8] 0.6823242 0.6823018 0.6822794 0.6822568 0.6822341 0.6822113 0.6821883
 [15] 0.6821653 0.6821421 0.6821187 0.6820953 0.6820717 0.6820480 0.6820242
 [22] 0.6820003 0.6819762 0.6819521 0.6819277 0.6819033 0.6818788 0.6818541
 [29] 0.6818293 0.6818044 0.6817793 0.6817542 0.6817289 0.6817035 0.6816779
 [36] 0.6816523 0.6816265 0.6816006 0.6815746 0.6815484 0.6815222 0.6814958
 [43] 0.6814693 0.6814426 0.6814159 0.6813890 0.6813620 0.6813349 0.6813076
 [50] 0.6812803 0.6812528 0.6812252 0.6811974 0.6811696 0.6811416 0.6811135
 [57] 0.6810853 0.6810569 0.6810285 0.6809999 0.6809712 0.6809424 0.6809134
 [64] 0.6808843 0.6808551 0.6808258 0.6807964 0.6807668 0.6807372 0.6807074
 [71] 0.6806774 0.6806474 0.6806172 0.6805870 0.6805566 0.6805260 0.6804954
 [78] 0.6804646 0.6804337 0.6804027 0.6803716 0.6803403 0.6803090 0.6802775
 [85] 0.6802459 0.6802141 0.6801823 0.6801503 0.6801182 0.6800860 0.6800537
 [92] 0.6800212 0.6799886 0.6799560 0.6799231 0.6798902 0.6798572 0.6798240
 [99] 0.6797907 0.6797573 0.6797237 0.6796901 0.6796563 0.6796224 0.6795884
[106] 0.6795543 0.6795200 0.6794857 0.6794512 0.6794166 0.6793818 0.6793470
[113] 0.6793120 0.6792769 0.6792417 0.6792064 0.6791710 0.6791354 0.6790997
[120] 0.6790639 0.6790280 0.6789920 0.6789558 0.6789195 0.6788831 0.6788466
[127] 0.6788100 0.6787733 0.6787364 0.6786994 0.6786623 0.6786251 0.6785877
[134] 0.6785503 0.6785127 0.6784750 0.6784372 0.6783993 0.6783612 0.6783231
[141] 0.6782848 0.6782464 0.6782079 0.6781692 0.6781305 0.6780916 0.6780526
[148] 0.6780135 0.6779743 0.6779349 0.6778955 0.6778559 0.6778162 0.6777764
[155] 0.6777365 0.6776964 0.6776563 0.6776160 0.6775756 0.6775351 0.6774945
[162] 0.6774537 0.6774129 0.6773719 0.6773308 0.6772896 0.6772483 0.6772068
[169] 0.6771653 0.6771236 0.6770818 0.6770399 0.6769979 0.6769557 0.6769135
[176] 0.6768711 0.6768286 0.6767860 0.6767433 0.6767005 0.6766575 0.6766144
[183] 0.6765713 0.6765280 0.6764846 0.6764410 0.6763974 0.6763536 0.6763098
[190] 0.6762658 0.6762217 0.6761775 0.6761331 0.6760887 0.6760441 0.6759994
[197] 0.6759547 0.6759098 0.6758647 0.6758196 0.6757744 0.6757290 0.6756835
[204] 0.6756379 0.6755922 0.6755464 0.6755005 0.6754544 0.6754083 0.6753620
[211] 0.6753156 0.6752691 0.6752225 0.6751758 0.6751289 0.6750820 0.6750349
[218] 0.6749877 0.6749404 0.6748930 0.6748455 0.6747979 0.6747501 0.6747023
[225] 0.6746543 0.6746062 0.6745580 0.6745097 0.6744613 0.6744127 0.6743641
[232] 0.6743153 0.6742664 0.6742175 0.6741684 0.6741191 0.6740698 0.6740204
[239] 0.6739708 0.6739212 0.6738714 0.6738215 0.6737715 0.6737214 0.6736712
[246] 0.6736209 0.6735704 0.6735199 0.6734692 0.6734185 0.6733676 0.6733166
[253] 0.6732655 0.6732142 0.6731629 0.6731115 0.6730599 0.6730083 0.6729565
[260] 0.6729046 0.6728526 0.6728005 0.6727483 0.6726960 0.6726435 0.6725910
[267] 0.6725383 0.6724856 0.6724327 0.6723797 0.6723266 0.6722734 0.6722201
[274] 0.6721667 0.6721132 0.6720595 0.6720058 0.6719519 0.6718979 0.6718439
[281] 0.6717897 0.6717354 0.6716810 0.6716264 0.6715718 0.6715171 0.6714622
[288] 0.6714073 0.6713522 0.6712971 0.6712418 0.6711864 0.6711309 0.6710753
[295] 0.6710196 0.6709638 0.6709079 0.6708518 0.6707957 0.6707394 0.6706831
[302] 0.6706266 0.6705701 0.6705134 0.6704566 0.6703997 0.6703427 0.6702856
[309] 0.6702284 0.6701711 0.6701136 0.6700561 0.6699985 0.6699407 0.6698829
[316] 0.6698249 0.6697668 0.6697086 0.6696504 0.6695920 0.6695335 0.6694749
[323] 0.6694162 0.6693574 0.6692984 0.6692394 0.6691803 0.6691211 0.6690617
[330] 0.6690023 0.6689427 0.6688831 0.6688233 0.6687634 0.6687035 0.6686434
[337] 0.6685832 0.6685229 0.6684625 0.6684020 0.6683414 0.6682807 0.6682199
[344] 0.6681590 0.6680980 0.6680368 0.6679756 0.6679143 0.6678528 0.6677913
[351] 0.6677297 0.6676679 0.6676061 0.6675441 0.6674820 0.6674199 0.6673576
[358] 0.6672952 0.6672328 0.6671702 0.6671075 0.6670447 0.6669819 0.6669189
[365] 0.6668558 0.6667926 0.6667293 0.6666659 0.6666024 0.6665388 0.6664751
[372] 0.6664113 0.6663474 0.6662833 0.6662192 0.6661550 0.6660907 0.6660263
[379] 0.6659618 0.6658971 0.6658324 0.6657676 0.6657027 0.6656376 0.6655725
[386] 0.6655073 0.6654419 0.6653765 0.6653110 0.6652453 0.6651796 0.6651138
[393] 0.6650478 0.6649818 0.6649156 0.6648494 0.6647831 0.6647166 0.6646501
[400] 0.6645835 0.6645167
> mx
[1] 0.682477
> 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/1ibbn1258121831.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/216881258121831.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/3evr11258121831.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/4goih1258121831.tab") 
> 
> system("convert tmp/1ibbn1258121831.ps tmp/1ibbn1258121831.png")
> system("convert tmp/216881258121831.ps tmp/216881258121831.png")
> system("convert tmp/3evr11258121831.ps tmp/3evr11258121831.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.810   0.504   0.962