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(107.56,107.70,107.67,107.67,107.72,108.35,108.25,108.26,108.31,108.33,108.36,108.36,108.97,109.62,109.60,109.64,109.65,109.64,109.93,109.81,109.77,110.10,110.40,110.50,111.89,112.10,111.92,112.15,112.16,112.17,112.32,112.38,112.34,113.14,113.18,113.21,113.76,113.99,113.95,113.93,114.01,114.10,114.11,114.10,114.12,114.68,114.71,114.73,115.81,116.01,116.12,116.49,116.51,116.60,117.01,117.01,117.12,117.22,118.38,118.80)
> x <- c(107.11,107.57,107.81,108.75,109.43,109.62,109.54,109.53,109.84,109.67,109.79,109.56,110.22,110.40,110.69,110.72,110.89,110.58,110.94,110.91,111.22,111.09,111.00,111.06,111.55,112.32,112.64,112.36,112.04,112.37,112.59,112.89,113.22,112.85,113.06,112.99,113.32,113.74,113.91,114.52,114.96,114.91,115.30,115.44,115.52,116.08,115.94,115.56,115.88,116.66,117.41,117.68,117.85,118.21,118.92,119.03,119.17,118.95,118.92,118.90)
> #'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.9810287 0.9810275 0.9810262 0.9810248 0.9810235 0.9810221 0.9810207
  [8] 0.9810193 0.9810179 0.9810164 0.9810150 0.9810135 0.9810119 0.9810104
 [15] 0.9810088 0.9810072 0.9810056 0.9810039 0.9810023 0.9810006 0.9809989
 [22] 0.9809971 0.9809954 0.9809936 0.9809918 0.9809900 0.9809881 0.9809862
 [29] 0.9809843 0.9809824 0.9809805 0.9809785 0.9809765 0.9809745 0.9809725
 [36] 0.9809704 0.9809683 0.9809662 0.9809641 0.9809619 0.9809598 0.9809576
 [43] 0.9809553 0.9809531 0.9809508 0.9809485 0.9809462 0.9809439 0.9809415
 [50] 0.9809392 0.9809368 0.9809343 0.9809319 0.9809294 0.9809269 0.9809244
 [57] 0.9809219 0.9809193 0.9809167 0.9809141 0.9809115 0.9809088 0.9809061
 [64] 0.9809034 0.9809007 0.9808980 0.9808952 0.9808924 0.9808896 0.9808867
 [71] 0.9808839 0.9808810 0.9808781 0.9808751 0.9808722 0.9808692 0.9808662
 [78] 0.9808632 0.9808602 0.9808571 0.9808540 0.9808509 0.9808477 0.9808446
 [85] 0.9808414 0.9808382 0.9808350 0.9808317 0.9808285 0.9808252 0.9808218
 [92] 0.9808185 0.9808151 0.9808117 0.9808083 0.9808049 0.9808014 0.9807980
 [99] 0.9807945 0.9807909 0.9807874 0.9807838 0.9807802 0.9807766 0.9807730
[106] 0.9807693 0.9807656 0.9807619 0.9807582 0.9807545 0.9807507 0.9807469
[113] 0.9807431 0.9807392 0.9807354 0.9807315 0.9807276 0.9807236 0.9807197
[120] 0.9807157 0.9807117 0.9807077 0.9807036 0.9806996 0.9806955 0.9806914
[127] 0.9806872 0.9806831 0.9806789 0.9806747 0.9806705 0.9806662 0.9806619
[134] 0.9806576 0.9806533 0.9806490 0.9806446 0.9806402 0.9806358 0.9806314
[141] 0.9806269 0.9806225 0.9806180 0.9806134 0.9806089 0.9806043 0.9805998
[148] 0.9805951 0.9805905 0.9805859 0.9805812 0.9805765 0.9805718 0.9805670
[155] 0.9805622 0.9805574 0.9805526 0.9805478 0.9805429 0.9805381 0.9805332
[162] 0.9805282 0.9805233 0.9805183 0.9805133 0.9805083 0.9805033 0.9804982
[169] 0.9804931 0.9804880 0.9804829 0.9804777 0.9804726 0.9804674 0.9804622
[176] 0.9804569 0.9804516 0.9804464 0.9804411 0.9804357 0.9804304 0.9804250
[183] 0.9804196 0.9804142 0.9804087 0.9804033 0.9803978 0.9803923 0.9803868
[190] 0.9803812 0.9803756 0.9803700 0.9803644 0.9803588 0.9803531 0.9803474
[197] 0.9803417 0.9803360 0.9803302 0.9803244 0.9803186 0.9803128 0.9803070
[204] 0.9803011 0.9802952 0.9802893 0.9802834 0.9802774 0.9802714 0.9802654
[211] 0.9802594 0.9802534 0.9802473 0.9802412 0.9802351 0.9802290 0.9802228
[218] 0.9802167 0.9802105 0.9802042 0.9801980 0.9801917 0.9801854 0.9801791
[225] 0.9801728 0.9801664 0.9801601 0.9801537 0.9801472 0.9801408 0.9801343
[232] 0.9801278 0.9801213 0.9801148 0.9801082 0.9801017 0.9800951 0.9800885
[239] 0.9800818 0.9800751 0.9800685 0.9800618 0.9800550 0.9800483 0.9800415
[246] 0.9800347 0.9800279 0.9800210 0.9800142 0.9800073 0.9800004 0.9799934
[253] 0.9799865 0.9799795 0.9799725 0.9799655 0.9799585 0.9799514 0.9799443
[260] 0.9799372 0.9799301 0.9799229 0.9799158 0.9799086 0.9799014 0.9798941
[267] 0.9798869 0.9798796 0.9798723 0.9798650 0.9798576 0.9798502 0.9798428
[274] 0.9798354 0.9798280 0.9798205 0.9798131 0.9798056 0.9797980 0.9797905
[281] 0.9797829 0.9797753 0.9797677 0.9797601 0.9797524 0.9797448 0.9797371
[288] 0.9797293 0.9797216 0.9797138 0.9797060 0.9796982 0.9796904 0.9796826
[295] 0.9796747 0.9796668 0.9796589 0.9796509 0.9796430 0.9796350 0.9796270
[302] 0.9796190 0.9796109 0.9796029 0.9795948 0.9795866 0.9795785 0.9795704
[309] 0.9795622 0.9795540 0.9795458 0.9795375 0.9795292 0.9795210 0.9795127
[316] 0.9795043 0.9794960 0.9794876 0.9794792 0.9794708 0.9794623 0.9794539
[323] 0.9794454 0.9794369 0.9794284 0.9794198 0.9794113 0.9794027 0.9793941
[330] 0.9793854 0.9793768 0.9793681 0.9793594 0.9793507 0.9793419 0.9793332
[337] 0.9793244 0.9793156 0.9793067 0.9792979 0.9792890 0.9792801 0.9792712
[344] 0.9792623 0.9792533 0.9792443 0.9792353 0.9792263 0.9792173 0.9792082
[351] 0.9791991 0.9791900 0.9791809 0.9791717 0.9791626 0.9791534 0.9791442
[358] 0.9791349 0.9791257 0.9791164 0.9791071 0.9790978 0.9790884 0.9790790
[365] 0.9790697 0.9790602 0.9790508 0.9790414 0.9790319 0.9790224 0.9790129
[372] 0.9790033 0.9789938 0.9789842 0.9789746 0.9789650 0.9789553 0.9789457
[379] 0.9789360 0.9789263 0.9789165 0.9789068 0.9788970 0.9788872 0.9788774
[386] 0.9788676 0.9788577 0.9788478 0.9788379 0.9788280 0.9788181 0.9788081
[393] 0.9787981 0.9787881 0.9787781 0.9787680 0.9787579 0.9787479 0.9787377
[400] 0.9787276 0.9787174
> mx
[1] 0.9810287
> 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/1ws931258111648.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/2akii1258111648.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/3hj411258111648.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/41el61258111648.tab") 
> 
> system("convert tmp/1ws931258111648.ps tmp/1ws931258111648.png")
> system("convert tmp/2akii1258111648.ps tmp/2akii1258111648.png")
> system("convert tmp/3hj411258111648.ps tmp/3hj411258111648.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.785   0.491   0.924