R version 2.6.0 (2007-10-03)
Copyright (C) 2007 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(101.5,126.6,93.9,89.8,93.4,101.5,110.4,105.9,108.4,113.9,86.1,69.4,101.2,100.5,98,106.6,90.1,96.9,125.9,112,100,123.9,79.8,83.4,113.6,112.9,104,109.9,99,106.3,128.9,111.1,102.9,130,87,87.5,117.6,103.4,110.8,112.6,102.5,112.4,135.6,105.1,127.7,137,91,90.5,122.4,123.3,124.3,120,118.1,119,142.7,123.6,129.6,146.9,108.7,99.4)
> x <- c(99,115.4,106.9,107.1,99.3,99.2,108.3,105.6,99.5,107.4,93.1,88.1,110.7,113.1,99.6,93.6,98.6,99.6,114.3,107.8,101.2,112.5,100.5,93.9,116.2,112,106.4,95.7,96,95.8,103,102.2,98.4,111.4,86.6,91.3,107.9,101.8,104.4,93.4,100.1,98.5,112.9,101.4,107.1,110.8,90.3,95.5,111.4,113,107.5,95.9,106.3,105.2,117.2,106.9,108.2,110,96.1,100.6)
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Prof. Dr. P. Wessa
> #To cite this work: Wessa P., (2007), Box-Cox Linearity Plot (v1.0.3) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_boxcoxlin.wasp/
> #Source of accompanying publication: Office for Research, Development, and Education
> #Technical description: Write here your technical program description
> 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.6892452 0.6892719 0.6892984 0.6893248 0.6893512 0.6893774 0.6894035
  [8] 0.6894295 0.6894554 0.6894811 0.6895068 0.6895324 0.6895578 0.6895832
 [15] 0.6896084 0.6896336 0.6896586 0.6896835 0.6897083 0.6897331 0.6897577
 [22] 0.6897821 0.6898065 0.6898308 0.6898550 0.6898791 0.6899030 0.6899269
 [29] 0.6899506 0.6899743 0.6899978 0.6900212 0.6900445 0.6900677 0.6900908
 [36] 0.6901138 0.6901367 0.6901595 0.6901822 0.6902048 0.6902272 0.6902496
 [43] 0.6902718 0.6902940 0.6903160 0.6903379 0.6903598 0.6903815 0.6904031
 [50] 0.6904246 0.6904460 0.6904673 0.6904885 0.6905095 0.6905305 0.6905514
 [57] 0.6905721 0.6905928 0.6906133 0.6906338 0.6906541 0.6906743 0.6906944
 [64] 0.6907145 0.6907344 0.6907542 0.6907739 0.6907935 0.6908129 0.6908323
 [71] 0.6908516 0.6908708 0.6908898 0.6909088 0.6909276 0.6909464 0.6909650
 [78] 0.6909835 0.6910020 0.6910203 0.6910385 0.6910566 0.6910746 0.6910925
 [85] 0.6911103 0.6911280 0.6911456 0.6911630 0.6911804 0.6911977 0.6912148
 [92] 0.6912319 0.6912488 0.6912657 0.6912824 0.6912990 0.6913156 0.6913320
 [99] 0.6913483 0.6913645 0.6913806 0.6913966 0.6914125 0.6914283 0.6914440
[106] 0.6914596 0.6914750 0.6914904 0.6915057 0.6915208 0.6915359 0.6915509
[113] 0.6915657 0.6915804 0.6915951 0.6916096 0.6916240 0.6916384 0.6916526
[120] 0.6916667 0.6916807 0.6916946 0.6917084 0.6917221 0.6917357 0.6917492
[127] 0.6917626 0.6917759 0.6917890 0.6918021 0.6918151 0.6918279 0.6918407
[134] 0.6918534 0.6918659 0.6918784 0.6918907 0.6919029 0.6919151 0.6919271
[141] 0.6919390 0.6919509 0.6919626 0.6919742 0.6919857 0.6919971 0.6920084
[148] 0.6920197 0.6920308 0.6920417 0.6920526 0.6920634 0.6920741 0.6920847
[155] 0.6920952 0.6921056 0.6921158 0.6921260 0.6921361 0.6921460 0.6921559
[162] 0.6921657 0.6921753 0.6921849 0.6921943 0.6922037 0.6922129 0.6922221
[169] 0.6922311 0.6922400 0.6922489 0.6922576 0.6922662 0.6922748 0.6922832
[176] 0.6922915 0.6922997 0.6923079 0.6923159 0.6923238 0.6923316 0.6923393
[183] 0.6923469 0.6923544 0.6923618 0.6923691 0.6923763 0.6923834 0.6923904
[190] 0.6923973 0.6924041 0.6924108 0.6924174 0.6924239 0.6924303 0.6924365
[197] 0.6924427 0.6924488 0.6924548 0.6924607 0.6924664 0.6924721 0.6924777
[204] 0.6924832 0.6924885 0.6924938 0.6924990 0.6925040 0.6925090 0.6925139
[211] 0.6925187 0.6925233 0.6925279 0.6925323 0.6925367 0.6925410 0.6925451
[218] 0.6925492 0.6925532 0.6925570 0.6925608 0.6925644 0.6925680 0.6925715
[225] 0.6925748 0.6925781 0.6925813 0.6925843 0.6925873 0.6925901 0.6925929
[232] 0.6925956 0.6925981 0.6926006 0.6926029 0.6926052 0.6926074 0.6926094
[239] 0.6926114 0.6926132 0.6926150 0.6926167 0.6926182 0.6926197 0.6926211
[246] 0.6926223 0.6926235 0.6926246 0.6926255 0.6926264 0.6926272 0.6926279
[253] 0.6926284 0.6926289 0.6926293 0.6926296 0.6926298 0.6926298 0.6926298
[260] 0.6926297 0.6926295 0.6926292 0.6926288 0.6926283 0.6926276 0.6926269
[267] 0.6926261 0.6926252 0.6926242 0.6926231 0.6926219 0.6926206 0.6926193
[274] 0.6926178 0.6926162 0.6926145 0.6926127 0.6926108 0.6926089 0.6926068
[281] 0.6926046 0.6926023 0.6926000 0.6925975 0.6925949 0.6925923 0.6925895
[288] 0.6925867 0.6925837 0.6925807 0.6925775 0.6925743 0.6925710 0.6925675
[295] 0.6925640 0.6925604 0.6925567 0.6925528 0.6925489 0.6925449 0.6925408
[302] 0.6925366 0.6925323 0.6925279 0.6925234 0.6925188 0.6925141 0.6925093
[309] 0.6925045 0.6924995 0.6924944 0.6924893 0.6924840 0.6924786 0.6924732
[316] 0.6924677 0.6924620 0.6924563 0.6924504 0.6924445 0.6924385 0.6924324
[323] 0.6924262 0.6924198 0.6924134 0.6924069 0.6924003 0.6923937 0.6923869
[330] 0.6923800 0.6923730 0.6923660 0.6923588 0.6923515 0.6923442 0.6923367
[337] 0.6923292 0.6923216 0.6923138 0.6923060 0.6922981 0.6922901 0.6922820
[344] 0.6922738 0.6922655 0.6922571 0.6922486 0.6922401 0.6922314 0.6922226
[351] 0.6922138 0.6922048 0.6921958 0.6921867 0.6921774 0.6921681 0.6921587
[358] 0.6921492 0.6921396 0.6921299 0.6921201 0.6921102 0.6921003 0.6920902
[365] 0.6920800 0.6920698 0.6920595 0.6920490 0.6920385 0.6920279 0.6920172
[372] 0.6920064 0.6919955 0.6919845 0.6919734 0.6919622 0.6919510 0.6919396
[379] 0.6919281 0.6919166 0.6919050 0.6918933 0.6918814 0.6918695 0.6918575
[386] 0.6918454 0.6918333 0.6918210 0.6918086 0.6917962 0.6917836 0.6917710
[393] 0.6917583 0.6917454 0.6917325 0.6917195 0.6917064 0.6916933 0.6916800
[400] 0.6916666 0.6916532
> mx
[1] 0.6926298
> mxli
[1] 0.57
> 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/1elmf1194085832.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/230cj1194085832.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/3b4vc1194085833.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 
> 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/44jna1194085833.tab") 
> 
> system("convert tmp/1elmf1194085832.ps tmp/1elmf1194085832.png")
> system("convert tmp/230cj1194085832.ps tmp/230cj1194085832.png")
> system("convert tmp/3b4vc1194085833.ps tmp/3b4vc1194085833.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.046   0.533   1.234