R version 2.8.0 (2008-10-20)
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(92.3,95.5,92.5,89.6,84.3,76.3,80.7,96.3,81,82.9,90.3,74.8,70.1,86.7,86.4,89.9,88.1,78.8,81.1,85.4,82.6,80.3,81.2,68,67.4,91.3,94.9,82.8,88.6,73.1,76.7,93.2,84.9,83.8,93.5,91.9,69.6,87,90.2,82.7,91.4,74.6,76.1,87.1,78.4,81.3,99.3,71,73.2,95.6,84,90.8,93.6,80.9,84.4,97.3,83.5,88.8,100.7,69.4,74.6,96.6,96.6,93.1,91.8,85.7,79.1,91.3,84.2,85.8,94.6,77.1,76.5)
> x <- c(95.5,98.7,115.9,110.4,109.5,92.3,102.1,112.8,110.2,98.9,119.0,104.3,98.8,109.4,170.3,118.0,116.9,111.7,116.8,116.1,114.8,110.8,122.8,104.7,86.0,127.2,126.1,114.6,127.8,105.2,113.1,161.0,126.9,117.7,144.9,119.4,107.1,142.8,126.2,126.9,179.2,105.3,114.8,125.4,113.2,134.4,150.0,100.9,101.8,137.7,138.7,135.4,153.8,119.5,123.3,166.4,137.5,142.2,167.0,112.3,120.6,154.9,153.4,156.2,175.8,131.7,130.1,161.1,128.2,140.3,174.9,111.8,136.6)
> 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.6331523 0.6332534 0.6333539 0.6334537 0.6335527 0.6336511 0.6337488
  [8] 0.6338458 0.6339421 0.6340377 0.6341327 0.6342269 0.6343204 0.6344133
 [15] 0.6345054 0.6345969 0.6346876 0.6347777 0.6348670 0.6349557 0.6350437
 [22] 0.6351309 0.6352175 0.6353034 0.6353885 0.6354730 0.6355568 0.6356398
 [29] 0.6357222 0.6358038 0.6358848 0.6359650 0.6360446 0.6361234 0.6362016
 [36] 0.6362790 0.6363557 0.6364317 0.6365070 0.6365816 0.6366555 0.6367287
 [43] 0.6368012 0.6368730 0.6369440 0.6370144 0.6370840 0.6371530 0.6372212
 [50] 0.6372887 0.6373555 0.6374216 0.6374870 0.6375516 0.6376156 0.6376788
 [57] 0.6377413 0.6378032 0.6378643 0.6379247 0.6379843 0.6380433 0.6381015
 [64] 0.6381591 0.6382159 0.6382720 0.6383274 0.6383820 0.6384360 0.6384892
 [71] 0.6385417 0.6385935 0.6386446 0.6386950 0.6387447 0.6387936 0.6388418
 [78] 0.6388893 0.6389361 0.6389822 0.6390275 0.6390721 0.6391161 0.6391593
 [85] 0.6392017 0.6392435 0.6392845 0.6393249 0.6393645 0.6394033 0.6394415
 [92] 0.6394790 0.6395157 0.6395517 0.6395870 0.6396216 0.6396554 0.6396886
 [99] 0.6397210 0.6397527 0.6397836 0.6398139 0.6398434 0.6398723 0.6399004
[106] 0.6399278 0.6399544 0.6399804 0.6400056 0.6400301 0.6400539 0.6400770
[113] 0.6400993 0.6401210 0.6401419 0.6401621 0.6401816 0.6402003 0.6402184
[120] 0.6402357 0.6402523 0.6402682 0.6402834 0.6402979 0.6403116 0.6403247
[127] 0.6403370 0.6403486 0.6403594 0.6403696 0.6403791 0.6403878 0.6403958
[134] 0.6404031 0.6404097 0.6404156 0.6404208 0.6404252 0.6404289 0.6404320
[141] 0.6404343 0.6404359 0.6404368 0.6404369 0.6404364 0.6404351 0.6404332
[148] 0.6404305 0.6404271 0.6404230 0.6404182 0.6404127 0.6404065 0.6403996
[155] 0.6403919 0.6403836 0.6403745 0.6403647 0.6403543 0.6403431 0.6403312
[162] 0.6403186 0.6403053 0.6402913 0.6402766 0.6402612 0.6402451 0.6402283
[169] 0.6402108 0.6401926 0.6401736 0.6401540 0.6401337 0.6401127 0.6400909
[176] 0.6400685 0.6400454 0.6400216 0.6399971 0.6399718 0.6399459 0.6399193
[183] 0.6398920 0.6398640 0.6398353 0.6398059 0.6397758 0.6397451 0.6397136
[190] 0.6396814 0.6396486 0.6396150 0.6395808 0.6395459 0.6395103 0.6394740
[197] 0.6394370 0.6393993 0.6393609 0.6393219 0.6392822 0.6392418 0.6392007
[204] 0.6391589 0.6391164 0.6390733 0.6390294 0.6389849 0.6389397 0.6388939
[211] 0.6388473 0.6388001 0.6387522 0.6387036 0.6386544 0.6386044 0.6385538
[218] 0.6385025 0.6384506 0.6383980 0.6383447 0.6382907 0.6382361 0.6381808
[225] 0.6381248 0.6380682 0.6380109 0.6379529 0.6378943 0.6378350 0.6377750
[232] 0.6377144 0.6376531 0.6375912 0.6375286 0.6374653 0.6374014 0.6373368
[239] 0.6372716 0.6372057 0.6371391 0.6370719 0.6370041 0.6369355 0.6368664
[246] 0.6367966 0.6367261 0.6366550 0.6365832 0.6365108 0.6364378 0.6363641
[253] 0.6362897 0.6362148 0.6361391 0.6360629 0.6359860 0.6359084 0.6358302
[260] 0.6357514 0.6356719 0.6355918 0.6355111 0.6354297 0.6353477 0.6352651
[267] 0.6351818 0.6350979 0.6350134 0.6349283 0.6348425 0.6347561 0.6346691
[274] 0.6345814 0.6344931 0.6344042 0.6343147 0.6342246 0.6341338 0.6340424
[281] 0.6339504 0.6338578 0.6337646 0.6336708 0.6335763 0.6334812 0.6333856
[288] 0.6332893 0.6331924 0.6330949 0.6329968 0.6328981 0.6327988 0.6326988
[295] 0.6325983 0.6324972 0.6323955 0.6322931 0.6321902 0.6320867 0.6319826
[302] 0.6318779 0.6317726 0.6316667 0.6315602 0.6314532 0.6313455 0.6312373
[309] 0.6311284 0.6310190 0.6309090 0.6307984 0.6306872 0.6305755 0.6304632
[316] 0.6303503 0.6302368 0.6301227 0.6300081 0.6298929 0.6297771 0.6296608
[323] 0.6295438 0.6294263 0.6293083 0.6291897 0.6290705 0.6289507 0.6288304
[330] 0.6287095 0.6285881 0.6284661 0.6283435 0.6282204 0.6280968 0.6279725
[337] 0.6278478 0.6277224 0.6275966 0.6274701 0.6273432 0.6272156 0.6270876
[344] 0.6269590 0.6268298 0.6267001 0.6265699 0.6264391 0.6263078 0.6261759
[351] 0.6260435 0.6259106 0.6257772 0.6256432 0.6255087 0.6253736 0.6252381
[358] 0.6251020 0.6249653 0.6248282 0.6246905 0.6245523 0.6244136 0.6242744
[365] 0.6241346 0.6239943 0.6238536 0.6237123 0.6235705 0.6234281 0.6232853
[372] 0.6231420 0.6229981 0.6228538 0.6227089 0.6225636 0.6224177 0.6222714
[379] 0.6221245 0.6219771 0.6218293 0.6216809 0.6215321 0.6213828 0.6212329
[386] 0.6210826 0.6209318 0.6207805 0.6206287 0.6204765 0.6203237 0.6201705
[393] 0.6200168 0.6198626 0.6197080 0.6195528 0.6193972 0.6192411 0.6190845
[400] 0.6189275 0.6187700
> mx
[1] 0.6404369
> 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/freestat/rcomp/tmp/1i7xx1226761793.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/freestat/rcomp/tmp/2q2wm1226761793.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/freestat/rcomp/tmp/3so341226761793.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/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/freestat/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/freestat/rcomp/tmp/4c5421226761793.tab") 
> 
> system("convert tmp/1i7xx1226761793.ps tmp/1i7xx1226761793.png")
> system("convert tmp/2q2wm1226761793.ps tmp/2q2wm1226761793.png")
> system("convert tmp/3so341226761793.ps tmp/3so341226761793.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.225   0.819   1.406