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(2564,3869,4145,4091,4117,3281,2186,3476,4009,3924,3101,2211,2497,3520,4191,8255,3000,2955,1986,3229,3448,3371,3160,2429,2574,2725,3451,3481,3592,3472,2312,3322,4348,3603,2700,2640,2916,3180,4151,4023,3431,3874,2617,3580,5267,3832,3441,3228,3397,3971,4625,4486,4132,4685,3172,4280,4207,4158,3933,3151,3616,4222,4436,4806,4849,5023,3521,4649,5388,5148,4847,3996,4483,4684,5454,4770,5309,5074,3505,4953,5155,5308,5171,4003,4379)
> x <- c(3595,3914,4159,3676,3794,3446,3504,3958,3353,3480,3098,2944,3389,3497,4404,3849,3734,3060,3507,3287,3215,3764,2734,2837,2766,3851,3289,3848,3348,3682,4058,3655,3811,3341,3032,3475,3353,3186,3902,4164,3499,4145,3796,3711,3949,3740,3243,4407,4814,3908,5250,3937,4004,5560,3922,3759,4138,4634,3996,4308,4143,4429,5219,4929,5755,5592,4163,4962,5208,4755,4491,5732,5731,5040,6102,4904,5369,5578,4619,4731,5011,5299,4146,4625,4736)
> #'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.6277382 0.6278660 0.6279931 0.6281193 0.6282448 0.6283695 0.6284934
  [8] 0.6286165 0.6287388 0.6288604 0.6289811 0.6291010 0.6292202 0.6293385
 [15] 0.6294561 0.6295728 0.6296888 0.6298039 0.6299182 0.6300318 0.6301445
 [22] 0.6302565 0.6303676 0.6304779 0.6305874 0.6306961 0.6308040 0.6309111
 [29] 0.6310174 0.6311229 0.6312275 0.6313314 0.6314344 0.6315366 0.6316380
 [36] 0.6317386 0.6318383 0.6319373 0.6320354 0.6321327 0.6322292 0.6323249
 [43] 0.6324197 0.6325138 0.6326070 0.6326993 0.6327909 0.6328816 0.6329715
 [50] 0.6330606 0.6331489 0.6332363 0.6333229 0.6334087 0.6334936 0.6335777
 [57] 0.6336610 0.6337434 0.6338251 0.6339059 0.6339858 0.6340649 0.6341432
 [64] 0.6342207 0.6342973 0.6343731 0.6344481 0.6345222 0.6345955 0.6346679
 [71] 0.6347395 0.6348103 0.6348802 0.6349494 0.6350176 0.6350850 0.6351516
 [78] 0.6352174 0.6352823 0.6353464 0.6354096 0.6354720 0.6355335 0.6355943
 [85] 0.6356541 0.6357132 0.6357714 0.6358287 0.6358852 0.6359409 0.6359957
 [92] 0.6360497 0.6361028 0.6361551 0.6362066 0.6362572 0.6363070 0.6363559
 [99] 0.6364040 0.6364512 0.6364976 0.6365432 0.6365879 0.6366318 0.6366748
[106] 0.6367170 0.6367584 0.6367989 0.6368385 0.6368773 0.6369153 0.6369525
[113] 0.6369888 0.6370242 0.6370588 0.6370926 0.6371255 0.6371576 0.6371888
[120] 0.6372192 0.6372488 0.6372775 0.6373054 0.6373324 0.6373586 0.6373840
[127] 0.6374085 0.6374321 0.6374550 0.6374770 0.6374981 0.6375185 0.6375379
[134] 0.6375566 0.6375744 0.6375913 0.6376075 0.6376228 0.6376372 0.6376508
[141] 0.6376636 0.6376756 0.6376867 0.6376970 0.6377064 0.6377150 0.6377228
[148] 0.6377298 0.6377359 0.6377412 0.6377456 0.6377492 0.6377520 0.6377540
[155] 0.6377551 0.6377554 0.6377549 0.6377536 0.6377514 0.6377484 0.6377446
[162] 0.6377399 0.6377344 0.6377281 0.6377210 0.6377131 0.6377043 0.6376947
[169] 0.6376843 0.6376731 0.6376610 0.6376482 0.6376345 0.6376200 0.6376047
[176] 0.6375885 0.6375716 0.6375538 0.6375352 0.6375159 0.6374957 0.6374746
[183] 0.6374528 0.6374302 0.6374068 0.6373825 0.6373575 0.6373316 0.6373049
[190] 0.6372775 0.6372492 0.6372201 0.6371903 0.6371596 0.6371281 0.6370958
[197] 0.6370628 0.6370289 0.6369943 0.6369588 0.6369225 0.6368855 0.6368477
[204] 0.6368090 0.6367696 0.6367294 0.6366884 0.6366467 0.6366041 0.6365607
[211] 0.6365166 0.6364717 0.6364260 0.6363795 0.6363323 0.6362842 0.6362354
[218] 0.6361858 0.6361355 0.6360843 0.6360324 0.6359798 0.6359263 0.6358721
[225] 0.6358171 0.6357613 0.6357048 0.6356475 0.6355895 0.6355307 0.6354711
[232] 0.6354108 0.6353497 0.6352879 0.6352253 0.6351619 0.6350978 0.6350329
[239] 0.6349673 0.6349010 0.6348339 0.6347660 0.6346974 0.6346281 0.6345580
[246] 0.6344872 0.6344156 0.6343433 0.6342702 0.6341965 0.6341219 0.6340467
[253] 0.6339707 0.6338940 0.6338166 0.6337384 0.6336595 0.6335799 0.6334995
[260] 0.6334185 0.6333367 0.6332542 0.6331709 0.6330870 0.6330024 0.6329170
[267] 0.6328309 0.6327441 0.6326566 0.6325684 0.6324795 0.6323899 0.6322995
[274] 0.6322085 0.6321168 0.6320244 0.6319312 0.6318374 0.6317429 0.6316477
[281] 0.6315518 0.6314552 0.6313580 0.6312600 0.6311613 0.6310620 0.6309620
[288] 0.6308613 0.6307600 0.6306579 0.6305552 0.6304518 0.6303477 0.6302430
[295] 0.6301376 0.6300315 0.6299248 0.6298174 0.6297093 0.6296006 0.6294912
[302] 0.6293811 0.6292704 0.6291591 0.6290471 0.6289344 0.6288211 0.6287071
[309] 0.6285925 0.6284773 0.6283614 0.6282448 0.6281277 0.6280099 0.6278914
[316] 0.6277723 0.6276526 0.6275323 0.6274113 0.6272897 0.6271675 0.6270446
[323] 0.6269211 0.6267970 0.6266723 0.6265470 0.6264210 0.6262945 0.6261673
[330] 0.6260395 0.6259111 0.6257821 0.6256525 0.6255223 0.6253915 0.6252601
[337] 0.6251281 0.6249954 0.6248622 0.6247284 0.6245941 0.6244591 0.6243235
[344] 0.6241874 0.6240506 0.6239133 0.6237754 0.6236369 0.6234979 0.6233583
[351] 0.6232180 0.6230773 0.6229359 0.6227940 0.6226515 0.6225085 0.6223649
[358] 0.6222207 0.6220760 0.6219307 0.6217848 0.6216384 0.6214915 0.6213440
[365] 0.6211960 0.6210474 0.6208982 0.6207485 0.6205983 0.6204475 0.6202962
[372] 0.6201444 0.6199920 0.6198391 0.6196857 0.6195317 0.6193772 0.6192222
[379] 0.6190667 0.6189106 0.6187540 0.6185969 0.6184393 0.6182812 0.6181226
[386] 0.6179634 0.6178038 0.6176436 0.6174829 0.6173217 0.6171601 0.6169979
[393] 0.6168352 0.6166720 0.6165084 0.6163442 0.6161796 0.6160144 0.6158488
[400] 0.6156827 0.6155161
> mx
[1] 0.6377554
> mxli
[1] -0.45
> 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/1g5dl1257958995.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/2ty3k1257958995.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/35qcu1257958995.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/48lzu1257958995.tab") 
> 
> system("convert tmp/1g5dl1257958995.ps tmp/1g5dl1257958995.png")
> system("convert tmp/2ty3k1257958995.ps tmp/2ty3k1257958995.png")
> system("convert tmp/35qcu1257958995.ps tmp/35qcu1257958995.png")
> 
> 
> proc.time()
   user  system elapsed 
  0.781   0.519   0.989