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(58.972,59.249,63.955,53.785,52.760,44.795,37.348,32.370,32.717,40.974,33.591,21.124,58.608,46.865,51.378,46.235,47.206,45.382,41.227,33.795,31.295,42.625,33.625,21.538,56.421,53.152,53.536,52.408,41.454,38.271,35.306,26.414,31.917,38.030,27.534,18.387,50.556,43.901,48.572,43.899,37.532,40.357,35.489,29.027,34.485,42.598,30.306,26.451,47.460,50.104,61.465,53.726,39.477,43.895,31.481,29.896,33.842,39.120,33.702,25.094)
> x <- c(493.000,481.000,462.000,457.000,442.000,439.000,488.000,521.000,501.000,485.000,464.000,460.000,467.000,460.000,448.000,443.000,436.000,431.000,484.000,510.000,513.000,503.000,471.000,471.000,476.000,475.000,470.000,461.000,455.000,456.000,517.000,525.000,523.000,519.000,509.000,512.000,519.000,517.000,510.000,509.000,501.000,507.000,569.000,580.000,578.000,565.000,547.000,555.000,562.000,561.000,555.000,544.000,537.000,543.000,594.000,611.000,613.000,611.000,594.000,595.000)
> #'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.3652678 -0.3652686 -0.3652694 -0.3652701 -0.3652707 -0.3652713
  [7] -0.3652718 -0.3652721 -0.3652725 -0.3652727 -0.3652728 -0.3652729
 [13] -0.3652729 -0.3652728 -0.3652727 -0.3652724 -0.3652721 -0.3652717
 [19] -0.3652712 -0.3652707 -0.3652701 -0.3652693 -0.3652686 -0.3652677
 [25] -0.3652667 -0.3652657 -0.3652646 -0.3652634 -0.3652622 -0.3652609
 [31] -0.3652594 -0.3652579 -0.3652564 -0.3652547 -0.3652530 -0.3652512
 [37] -0.3652493 -0.3652473 -0.3652453 -0.3652432 -0.3652410 -0.3652387
 [43] -0.3652364 -0.3652339 -0.3652314 -0.3652288 -0.3652261 -0.3652234
 [49] -0.3652206 -0.3652177 -0.3652147 -0.3652116 -0.3652085 -0.3652053
 [55] -0.3652020 -0.3651986 -0.3651951 -0.3651916 -0.3651880 -0.3651843
 [61] -0.3651805 -0.3651767 -0.3651728 -0.3651688 -0.3651647 -0.3651605
 [67] -0.3651563 -0.3651520 -0.3651476 -0.3651431 -0.3651386 -0.3651339
 [73] -0.3651292 -0.3651244 -0.3651196 -0.3651146 -0.3651096 -0.3651045
 [79] -0.3650993 -0.3650941 -0.3650888 -0.3650833 -0.3650778 -0.3650723
 [85] -0.3650666 -0.3650609 -0.3650551 -0.3650492 -0.3650433 -0.3650372
 [91] -0.3650311 -0.3650249 -0.3650186 -0.3650123 -0.3650059 -0.3649993
 [97] -0.3649928 -0.3649861 -0.3649794 -0.3649725 -0.3649656 -0.3649587
[103] -0.3649516 -0.3649445 -0.3649373 -0.3649300 -0.3649226 -0.3649152
[109] -0.3649076 -0.3649000 -0.3648924 -0.3648846 -0.3648768 -0.3648689
[115] -0.3648609 -0.3648528 -0.3648446 -0.3648364 -0.3648281 -0.3648197
[121] -0.3648113 -0.3648027 -0.3647941 -0.3647854 -0.3647767 -0.3647678
[127] -0.3647589 -0.3647499 -0.3647408 -0.3647317 -0.3647224 -0.3647131
[133] -0.3647037 -0.3646943 -0.3646847 -0.3646751 -0.3646654 -0.3646556
[139] -0.3646458 -0.3646358 -0.3646258 -0.3646157 -0.3646056 -0.3645953
[145] -0.3645850 -0.3645746 -0.3645641 -0.3645536 -0.3645429 -0.3645322
[151] -0.3645215 -0.3645106 -0.3644997 -0.3644886 -0.3644775 -0.3644664
[157] -0.3644551 -0.3644438 -0.3644324 -0.3644209 -0.3644094 -0.3643977
[163] -0.3643860 -0.3643743 -0.3643624 -0.3643504 -0.3643384 -0.3643263
[169] -0.3643142 -0.3643019 -0.3642896 -0.3642772 -0.3642647 -0.3642522
[175] -0.3642395 -0.3642268 -0.3642141 -0.3642012 -0.3641883 -0.3641753
[181] -0.3641622 -0.3641490 -0.3641358 -0.3641224 -0.3641090 -0.3640956
[187] -0.3640820 -0.3640684 -0.3640547 -0.3640409 -0.3640271 -0.3640132
[193] -0.3639992 -0.3639851 -0.3639709 -0.3639567 -0.3639424 -0.3639280
[199] -0.3639136 -0.3638990 -0.3638844 -0.3638697 -0.3638550 -0.3638401
[205] -0.3638252 -0.3638102 -0.3637952 -0.3637800 -0.3637648 -0.3637495
[211] -0.3637342 -0.3637187 -0.3637032 -0.3636876 -0.3636719 -0.3636562
[217] -0.3636404 -0.3636245 -0.3636085 -0.3635925 -0.3635764 -0.3635602
[223] -0.3635439 -0.3635276 -0.3635112 -0.3634947 -0.3634781 -0.3634615
[229] -0.3634448 -0.3634280 -0.3634111 -0.3633942 -0.3633771 -0.3633601
[235] -0.3633429 -0.3633257 -0.3633084 -0.3632910 -0.3632735 -0.3632560
[241] -0.3632384 -0.3632207 -0.3632029 -0.3631851 -0.3631672 -0.3631492
[247] -0.3631312 -0.3631130 -0.3630949 -0.3630766 -0.3630582 -0.3630398
[253] -0.3630213 -0.3630028 -0.3629841 -0.3629654 -0.3629466 -0.3629278
[259] -0.3629088 -0.3628898 -0.3628707 -0.3628516 -0.3628324 -0.3628131
[265] -0.3627937 -0.3627742 -0.3627547 -0.3627351 -0.3627155 -0.3626957
[271] -0.3626759 -0.3626560 -0.3626361 -0.3626161 -0.3625960 -0.3625758
[277] -0.3625555 -0.3625352 -0.3625148 -0.3624944 -0.3624738 -0.3624532
[283] -0.3624326 -0.3624118 -0.3623910 -0.3623701 -0.3623491 -0.3623281
[289] -0.3623070 -0.3622858 -0.3622645 -0.3622432 -0.3622218 -0.3622004
[295] -0.3621788 -0.3621572 -0.3621355 -0.3621138 -0.3620920 -0.3620701
[301] -0.3620481 -0.3620261 -0.3620040 -0.3619818 -0.3619595 -0.3619372
[307] -0.3619148 -0.3618924 -0.3618698 -0.3618472 -0.3618245 -0.3618018
[313] -0.3617790 -0.3617561 -0.3617332 -0.3617101 -0.3616870 -0.3616639
[319] -0.3616406 -0.3616173 -0.3615940 -0.3615705 -0.3615470 -0.3615234
[325] -0.3614998 -0.3614760 -0.3614522 -0.3614284 -0.3614045 -0.3613805
[331] -0.3613564 -0.3613322 -0.3613080 -0.3612838 -0.3612594 -0.3612350
[337] -0.3612105 -0.3611860 -0.3611613 -0.3611367 -0.3611119 -0.3610871
[343] -0.3610622 -0.3610372 -0.3610122 -0.3609871 -0.3609619 -0.3609367
[349] -0.3609114 -0.3608860 -0.3608606 -0.3608351 -0.3608095 -0.3607838
[355] -0.3607581 -0.3607323 -0.3607065 -0.3606806 -0.3606546 -0.3606286
[361] -0.3606024 -0.3605763 -0.3605500 -0.3605237 -0.3604973 -0.3604709
[367] -0.3604443 -0.3604177 -0.3603911 -0.3603644 -0.3603376 -0.3603107
[373] -0.3602838 -0.3602568 -0.3602298 -0.3602027 -0.3601755 -0.3601482
[379] -0.3601209 -0.3600936 -0.3600661 -0.3600386 -0.3600110 -0.3599834
[385] -0.3599557 -0.3599279 -0.3599001 -0.3598722 -0.3598442 -0.3598161
[391] -0.3597880 -0.3597599 -0.3597317 -0.3597034 -0.3596750 -0.3596466
[397] -0.3596181 -0.3595895 -0.3595609 -0.3595322 -0.3595035
> mx
[1] 0.3652729
> mxli
[1] -1.89
> 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/1qx6i1229613799.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/2iaic1229613799.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/3jsi71229613800.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/4zsfq1229613800.tab") 
> 
> system("convert tmp/1qx6i1229613799.ps tmp/1qx6i1229613799.png")
> system("convert tmp/2iaic1229613799.ps tmp/2iaic1229613799.png")
> system("convert tmp/3jsi71229613800.ps tmp/3jsi71229613800.png")
> 
> 
> proc.time()
   user  system elapsed 
  3.320   1.395   3.498