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(9.4,9.5,9.1,9,9.3,9.9,9.8,9.4,8.3,8,8.5,10.4,11.1,10.9,9.9,9.2,9.2,9.5,9.6,9.5,9.1,8.9,9,10.1,10.3,10.2,9.6,9.2,9.3,9.4,9.4,9.2,9,9,9,9.8,10,9.9,9.3,9,9,9.1,9.1,9.1,9.2,8.8,8.3,8.4,8.1,7.8,7.9,7.9,8,7.9,7.5,7.2,6.9,6.6,6.7,7.3)
> x <- c(7.5,7.6,7.9,7.9,8.1,8.2,8,7.5,6.8,6.5,6.6,7.6,8,8,7.7,7.5,7.6,7.7,7.9,7.8,7.5,7.5,7.1,7.5,7.5,7.6,7.7,7.7,7.9,8.1,8.2,8.2,8.1,7.9,7.3,6.9,6.6,6.7,6.9,7,7.1,7.2,7.1,6.9,7,6.8,6.4,6.7,6.7,6.4,6.3,6.2,6.5,6.8,6.8,6.5,6.3,5.9,5.9,6.4)
> #'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.7736963 0.7736095 0.7735224 0.7734353 0.7733479 0.7732605 0.7731728
  [8] 0.7730850 0.7729970 0.7729089 0.7728206 0.7727321 0.7726435 0.7725547
 [15] 0.7724658 0.7723767 0.7722875 0.7721981 0.7721085 0.7720188 0.7719289
 [22] 0.7718388 0.7717486 0.7716583 0.7715678 0.7714771 0.7713862 0.7712953
 [29] 0.7712041 0.7711128 0.7710214 0.7709297 0.7708380 0.7707460 0.7706540
 [36] 0.7705617 0.7704693 0.7703768 0.7702841 0.7701912 0.7700982 0.7700051
 [43] 0.7699117 0.7698183 0.7697246 0.7696309 0.7695369 0.7694428 0.7693486
 [50] 0.7692542 0.7691597 0.7690650 0.7689701 0.7688751 0.7687800 0.7686847
 [57] 0.7685892 0.7684936 0.7683979 0.7683019 0.7682059 0.7681097 0.7680133
 [64] 0.7679168 0.7678202 0.7677234 0.7676264 0.7675293 0.7674320 0.7673346
 [71] 0.7672371 0.7671394 0.7670415 0.7669435 0.7668454 0.7667471 0.7666487
 [78] 0.7665501 0.7664513 0.7663525 0.7662534 0.7661543 0.7660550 0.7659555
 [85] 0.7658559 0.7657561 0.7656562 0.7655562 0.7654560 0.7653557 0.7652552
 [92] 0.7651545 0.7650538 0.7649529 0.7648518 0.7647506 0.7646493 0.7645478
 [99] 0.7644462 0.7643444 0.7642425 0.7641404 0.7640382 0.7639359 0.7638334
[106] 0.7637308 0.7636280 0.7635251 0.7634221 0.7633189 0.7632156 0.7631121
[113] 0.7630085 0.7629047 0.7628008 0.7626968 0.7625927 0.7624883 0.7623839
[120] 0.7622793 0.7621746 0.7620697 0.7619648 0.7618596 0.7617543 0.7616489
[127] 0.7615434 0.7614377 0.7613319 0.7612259 0.7611198 0.7610136 0.7609072
[134] 0.7608007 0.7606941 0.7605873 0.7604804 0.7603734 0.7602662 0.7601589
[141] 0.7600515 0.7599439 0.7598362 0.7597283 0.7596203 0.7595122 0.7594040
[148] 0.7592956 0.7591871 0.7590785 0.7589697 0.7588608 0.7587517 0.7586426
[155] 0.7585333 0.7584238 0.7583143 0.7582046 0.7580947 0.7579848 0.7578747
[162] 0.7577645 0.7576541 0.7575437 0.7574331 0.7573223 0.7572115 0.7571005
[169] 0.7569894 0.7568781 0.7567667 0.7566552 0.7565436 0.7564318 0.7563200
[176] 0.7562079 0.7560958 0.7559835 0.7558711 0.7557586 0.7556460 0.7555332
[183] 0.7554203 0.7553073 0.7551942 0.7550809 0.7549675 0.7548540 0.7547403
[190] 0.7546266 0.7545127 0.7543986 0.7542845 0.7541702 0.7540559 0.7539413
[197] 0.7538267 0.7537120 0.7535971 0.7534821 0.7533670 0.7532517 0.7531364
[204] 0.7530209 0.7529053 0.7527896 0.7526737 0.7525577 0.7524417 0.7523254
[211] 0.7522091 0.7520927 0.7519761 0.7518594 0.7517426 0.7516257 0.7515087
[218] 0.7513915 0.7512742 0.7511568 0.7510393 0.7509217 0.7508040 0.7506861
[225] 0.7505681 0.7504500 0.7503318 0.7502135 0.7500950 0.7499765 0.7498578
[232] 0.7497390 0.7496201 0.7495011 0.7493819 0.7492627 0.7491433 0.7490239
[239] 0.7489043 0.7487846 0.7486647 0.7485448 0.7484248 0.7483046 0.7481843
[246] 0.7480640 0.7479435 0.7478229 0.7477021 0.7475813 0.7474604 0.7473393
[253] 0.7472182 0.7470969 0.7469755 0.7468540 0.7467324 0.7466107 0.7464889
[260] 0.7463669 0.7462449 0.7461227 0.7460005 0.7458781 0.7457556 0.7456330
[267] 0.7455103 0.7453875 0.7452646 0.7451416 0.7450185 0.7448953 0.7447719
[274] 0.7446485 0.7445249 0.7444013 0.7442775 0.7441536 0.7440297 0.7439056
[281] 0.7437814 0.7436571 0.7435327 0.7434082 0.7432836 0.7431589 0.7430341
[288] 0.7429092 0.7427842 0.7426591 0.7425338 0.7424085 0.7422831 0.7421576
[295] 0.7420319 0.7419062 0.7417804 0.7416544 0.7415284 0.7414022 0.7412760
[302] 0.7411496 0.7410232 0.7408967 0.7407700 0.7406433 0.7405164 0.7403895
[309] 0.7402625 0.7401353 0.7400081 0.7398807 0.7397533 0.7396258 0.7394981
[316] 0.7393704 0.7392426 0.7391146 0.7389866 0.7388585 0.7387303 0.7386020
[323] 0.7384736 0.7383451 0.7382165 0.7380878 0.7379590 0.7378301 0.7377011
[330] 0.7375720 0.7374428 0.7373136 0.7371842 0.7370547 0.7369252 0.7367955
[337] 0.7366658 0.7365360 0.7364061 0.7362760 0.7361459 0.7360157 0.7358854
[344] 0.7357550 0.7356246 0.7354940 0.7353633 0.7352326 0.7351017 0.7349708
[351] 0.7348398 0.7347086 0.7345774 0.7344461 0.7343148 0.7341833 0.7340517
[358] 0.7339201 0.7337883 0.7336565 0.7335246 0.7333925 0.7332604 0.7331283
[365] 0.7329960 0.7328636 0.7327312 0.7325986 0.7324660 0.7323333 0.7322005
[372] 0.7320676 0.7319346 0.7318016 0.7316684 0.7315352 0.7314019 0.7312685
[379] 0.7311350 0.7310014 0.7308678 0.7307340 0.7306002 0.7304663 0.7303323
[386] 0.7301982 0.7300641 0.7299298 0.7297955 0.7296611 0.7295266 0.7293920
[393] 0.7292574 0.7291226 0.7289878 0.7288529 0.7287179 0.7285829 0.7284477
[400] 0.7283125 0.7281772
> mx
[1] 0.7736963
> 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/freestat/rcomp/tmp/16gwz1229039599.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/2tn7d1229039599.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/30tze1229039599.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/436i71229039599.tab") 
> 
> system("convert tmp/16gwz1229039599.ps tmp/16gwz1229039599.png")
> system("convert tmp/2tn7d1229039599.ps tmp/2tn7d1229039599.png")
> system("convert tmp/30tze1229039599.ps tmp/30tze1229039599.png")
> 
> 
> proc.time()
   user  system elapsed 
  1.209   0.789   1.305