Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
581000 597000 587000 536000 524000 537000 536000 533000 528000 516000 502000 506000 518000 534000 528000 478000 469000 490000 493000 508000 517000 514000 510000 527000 542000 565000 555000 499000 511000 526000 532000 549000 561000 557000 566000 588000 620000 626000 620000 573000 573000 574000 580000 590000 593000 597000 595000 612000 628000 629000 621000 569000 567000 573000 584000 589000 591000 595000 594000 611000
Data Y:
282965 276610 277838 277051 277026 274960 270073 267063 264916 287182 291109 292223 288109 281400 282579 280113 280331 276759 275139 274275 271234 289725 290649 292223 278429 269749 265784 268957 264099 255121 253276 245980 235295 258479 260916 254586 250566 243345 247028 248464 244962 237003 237008 225477 226762 247857 248256 246892 245021 246186 255688 264242 268270 272969 273886 267353 271916 292633 295804 293222
Sample Range:
(leave blank to include all observations)
From:
To:
Chart options
Label y-axis:
Label x-axis:
R Code
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 mx mxli 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)) bitmap(file='test1.png') plot(l,c,main='Box-Cox Linearity Plot',xlab='Lambda',ylab='correlation') grid() dev.off() bitmap(file='test2.png') plot(x,y,main='Linear Fit of Original Data',xlab='x',ylab='y') abline(r) grid() mtext(paste('Residual Standard Deviation = ',se)) dev.off() bitmap(file='test3.png') plot(x1,y,main='Linear Fit of Transformed Data',xlab='x',ylab='y') abline(r1) grid() mtext(paste('Residual Standard Deviation = ',se1)) dev.off() load(file='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='mytable.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation