Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
280.7 235.1 264.6 280.7 240.7 264.6 201.4 240.7 240.8 201.4 241.1 240.8 223.8 241.1 206.1 223.8 174.7 206.1 203.3 174.7 220.5 203.3 299.5 220.5 347.4 299.5 338.3 347.4 327.7 338.3 351.6 327.7 396.6 351.6 438.8 396.6 395.6 438.8 363.5 395.6 378.8 363.5 357 378.8 369 357 464.8 369 479.1 464.8 431.3 479.1 366.5 431.3 326.3 366.5 355.1 326.3 331.6 355.1 261.3 331.6 249 261.3 205.5 249 235.6 205.5 240.9 235.6 264.9 240.9 253.8 264.9 232.3 253.8 193.8 232.3 177 193.8 213.2 177 207.2 213.2 180.6 207.2 188.6 180.6 175.4 188.6 199 175.4 179.6 199 225.8 179.6 234 225.8 200.2 234 183.6 200.2 178.2 183.6 203.2 178.2 208.5 203.2 191.8 208.5 172.8 191.8 148 172.8 159.4 148 154.5 159.4 213.2 154.5 196.4 213.2 182.8 196.4 176.4 182.8 153.6 176.4 173.2 153.6 171 173.2 151.2 171 161.9 151.2 157.2 161.9 201.7 157.2 236.4 201.7 356.1 236.4 398.3 356.1 403.7 398.3 384.6 403.7 365.8 384.6 368.1 365.8 367.9 368.1 347 367.9 343.3 347 292.9 343.3 311.5 292.9 300.9 311.5 366.9 300.9 356.9 366.9 329.7 356.9 316.2 329.7 269 316.2 289.3 269 266.2 289.3 253.6 266.2 233.8 253.6 228.4 233.8 253.6 228.4 260.1 253.6 306.6 260.1 309.2 306.6 309.5 309.2 271 309.5 279.9 271 317.9 279.9 298.4 317.9 246.7 298.4 227.3 246.7 209.1 227.3 259.9 209.1 266 259.9 320.6 266 308.5 320.6 282.2 308.5 262.7 282.2 263.5 262.7 313.1 263.5 284.3 313.1 252.6 284.3 250.3 252.6 246.5 250.3 312.7 246.5 333.2 312.7 446.4 333.2 511.6 446.4 515.5 511.6 506.4 515.5 483.2 506.4 522.3 483.2 509.8 522.3 460.7 509.8 405.8 460.7 375 405.8 378.5 375 406.8 378.5 467.8 406.8 469.8 467.8 429.8 469.8 355.8 429.8 332.7 355.8 378 332.7 360.5 378 334.7 360.5 319.5 334.7 323.1 319.5 363.6 323.1 352.1 363.6 411.9 352.1 388.6 411.9 416.4 388.6 360.7 416.4 338 360.7 417.2 338 388.4 417.2 371.1 388.4 331.5 371.1 353.7 331.5 396.7 353.7 447 396.7 533.5 447 565.4 533.5 542.3 565.4 488.7 542.3 467.1 488.7 531.3 467.1 496.1 531.3 444 496.1 403.4 444 386.3 403.4 394.1 386.3 404.1 394.1 462.1 404.1 448.1 462.1 432.3 448.1 386.3 432.3 395.2 386.3 421.9 395.2 382.9 421.9 384.2 382.9 345.5 384.2 323.4 345.5 372.6 323.4 376 372.6 462.7 376 487 462.7 444.2 487 399.3 444.2 394.9 399.3 455.4 394.9 414 455.4 375.5 414 347 375.5 339.4 347 385.8 339.4 378.8 385.8 451.8 378.8 446.1 451.8 422.5 446.1 383.1 422.5 352.8 383.1 445.3 352.8 367.5 445.3 355.1 367.5 326.2 355.1 319.8 326.2 331.8 319.8 340.9 331.8 394.1 340.9 417.2 394.1 369.9 417.2 349.2 369.9 321.4 349.2 405.7 321.4 342.9 405.7 316.5 342.9 284.2 316.5 270.9 284.2 288.8 270.9 278.8 288.8 324.4 278.8 310.9 324.4 299 310.9 273 299 279.3 273 359.2 279.3 305 359.2 282.1 305 250.3 282.1 246.5 250.3 257.9 246.5 266.5 257.9 315.9 266.5 318.4 315.9 295.4 318.4 266.4 295.4 245.8 266.4 362.8 245.8 324.9 362.8 294.2 324.9 289.5 294.2 295.2 289.5 290.3 295.2 272 290.3 307.4 272 328.7 307.4 292.9 328.7 249.1 292.9 230.4 249.1 361.5 230.4 321.7 361.5 277.2 321.7 260.7 277.2 251 260.7 257.6 251 241.8 257.6 287.5 241.8 292.3 287.5 274.7 292.3 254.2 274.7 230 254.2 339 230 318.2 339 287 318.2 295.8 287 284 295.8 271 284 262.7 271 340.6 262.7 379.4 340.6 373.3 379.4 355.2 373.3 338.4 355.2 466.9 338.4 451 466.9 422 451 429.2 422 425.9 429.2 460.7 425.9 463.6 460.7 541.4 463.6 544.2 541.4 517.5 544.2 469.4 517.5 439.4 469.4 549 439.4 533 549 506.1 533 484 506.1 457 484 481.5 457 469.5 481.5 544.7 469.5 541.2 544.7 521.5 541.2 469.7 521.5 434.4 469.7 542.6 434.4 517.3 542.6 485.7 517.3 465.8 485.7 447 465.8 426.6 447 411.6 426.6 467.5 411.6 484.5 467.5 451.2 484.5 417.4 451.2 379.9 417.4 484.7 379.9 455 484.7 420.8 455 416.5 420.8 376.3 416.5 405.6 376.3 405.8 405.6 500.8 405.8 514 500.8 475.5 514 430.1 475.5 414.4 430.1 538 414.4 526 538 488.5 526 520.2 488.5 504.4 520.2 568.5 504.4 610.6 568.5 818 610.6 830.9 818 835.9 830.9 782 835.9 762.3 782 856.9 762.3 820.9 856.9 769.6 820.9 752.2 769.6 724.4 752.2 723.1 724.4 719.5 723.1 817.4 719.5 803.3 817.4 752.5 803.3 689 752.5 630.4 689 765.5 630.4 757.7 765.5 732.2 757.7 702.6 732.2 683.3 702.6 709.5 683.3 702.2 709.5 784.8 702.2 810.9 784.8 755.6 810.9 656.8 755.6 615.1 656.8 745.3 615.1 694.1 745.3 675.7 694.1 643.7 675.7 622.1 643.7 634.6 622.1 588 634.6 689.7 588 673.9 689.7 647.9 673.9 568.8 647.9 545.7 568.8 632.6 545.7 643.8 632.6 593.1 643.8 579.7 593.1 546 579.7 562.9 546 572.5 562.9
Names of X columns:
MW1 MW2
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
Single
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
additive
No Linear Trend
Linear Trend
First Differences
Seasonal Differences (s)
First and Seasonal Differences (s)
Degree of Predetermination (lagged endogenous variables)
Degree of Seasonal Predetermination
Seasonality
12
1
2
3
4
5
6
7
8
9
10
11
12
Chart options
R Code
library(lattice) library(lmtest) n25 <- 25 #minimum number of obs. for Goldfeld-Quandt test par1 <- as.numeric(par1) x <- t(y) k <- length(x[1,]) n <- length(x[,1]) x1 <- cbind(x[,par1], x[,1:k!=par1]) mycolnames <- c(colnames(x)[par1], colnames(x)[1:k!=par1]) colnames(x1) <- mycolnames #colnames(x)[par1] x <- x1 if (par3 == 'First Differences'){ x2 <- array(0, dim=c(n-1,k), dimnames=list(1:(n-1), paste('(1-B)',colnames(x),sep=''))) for (i in 1:n-1) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 } if (par2 == 'Include Monthly Dummies'){ x2 <- array(0, dim=c(n,11), dimnames=list(1:n, paste('M', seq(1:11), sep =''))) for (i in 1:11){ x2[seq(i,n,12),i] <- 1 } x <- cbind(x, x2) } if (par2 == 'Include Quarterly Dummies'){ x2 <- array(0, dim=c(n,3), dimnames=list(1:n, paste('Q', seq(1:3), sep =''))) for (i in 1:3){ x2[seq(i,n,4),i] <- 1 } x <- cbind(x, x2) } k <- length(x[1,]) if (par3 == 'Linear Trend'){ x <- cbind(x, c(1:n)) colnames(x)[k+1] <- 't' } x k <- length(x[1,]) df <- as.data.frame(x) (mylm <- lm(df)) (mysum <- summary(mylm)) if (n > n25) { kp3 <- k + 3 nmkm3 <- n - k - 3 gqarr <- array(NA, dim=c(nmkm3-kp3+1,3)) numgqtests <- 0 numsignificant1 <- 0 numsignificant5 <- 0 numsignificant10 <- 0 for (mypoint in kp3:nmkm3) { j <- 0 numgqtests <- numgqtests + 1 for (myalt in c('greater', 'two.sided', 'less')) { j <- j + 1 gqarr[mypoint-kp3+1,j] <- gqtest(mylm, point=mypoint, alternative=myalt)$p.value } if (gqarr[mypoint-kp3+1,2] < 0.01) numsignificant1 <- numsignificant1 + 1 if (gqarr[mypoint-kp3+1,2] < 0.05) numsignificant5 <- numsignificant5 + 1 if (gqarr[mypoint-kp3+1,2] < 0.10) numsignificant10 <- numsignificant10 + 1 } gqarr } bitmap(file='test0.png') plot(x[,1], type='l', main='Actuals and Interpolation', ylab='value of Actuals and Interpolation (dots)', xlab='time or index') points(x[,1]-mysum$resid) grid() dev.off() bitmap(file='test1.png') plot(mysum$resid, type='b', pch=19, main='Residuals', ylab='value of Residuals', xlab='time or index') grid() dev.off() bitmap(file='test2.png') hist(mysum$resid, main='Residual Histogram', xlab='values of Residuals') grid() dev.off() bitmap(file='test3.png') densityplot(~mysum$resid,col='black',main='Residual Density Plot', xlab='values of Residuals') dev.off() bitmap(file='test4.png') qqnorm(mysum$resid, main='Residual Normal Q-Q Plot') qqline(mysum$resid) grid() dev.off() (myerror <- as.ts(mysum$resid)) bitmap(file='test5.png') dum <- cbind(lag(myerror,k=1),myerror) dum dum1 <- dum[2:length(myerror),] dum1 z <- as.data.frame(dum1) z plot(z,main=paste('Residual Lag plot, lowess, and regression line'), ylab='values of Residuals', xlab='lagged values of Residuals') lines(lowess(z)) abline(lm(z)) grid() dev.off() bitmap(file='test6.png') acf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Autocorrelation Function') grid() dev.off() bitmap(file='test7.png') pacf(mysum$resid, lag.max=length(mysum$resid)/2, main='Residual Partial Autocorrelation Function') grid() dev.off() bitmap(file='test8.png') opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0)) plot(mylm, las = 1, sub='Residual Diagnostics') par(opar) dev.off() if (n > n25) { bitmap(file='test9.png') plot(kp3:nmkm3,gqarr[,2], main='Goldfeld-Quandt test',ylab='2-sided p-value',xlab='breakpoint') grid() dev.off() } load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a, 'Multiple Linear Regression - Estimated Regression Equation', 1, TRUE) a<-table.row.end(a) myeq <- colnames(x)[1] myeq <- paste(myeq, '[t] = ', sep='') for (i in 1:k){ if (mysum$coefficients[i,1] > 0) myeq <- paste(myeq, '+', '') myeq <- paste(myeq, mysum$coefficients[i,1], sep=' ') if (rownames(mysum$coefficients)[i] != '(Intercept)') { myeq <- paste(myeq, rownames(mysum$coefficients)[i], sep='') if (rownames(mysum$coefficients)[i] != 't') myeq <- paste(myeq, '[t]', sep='') } } myeq <- paste(myeq, ' + e[t]') a<-table.row.start(a) a<-table.element(a, myeq) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable1.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,hyperlink('http://www.xycoon.com/ols1.htm','Multiple Linear Regression - Ordinary Least Squares',''), 6, TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Variable',header=TRUE) a<-table.element(a,'Parameter',header=TRUE) a<-table.element(a,'S.D.',header=TRUE) a<-table.element(a,'T-STAT<br />H0: parameter = 0',header=TRUE) a<-table.element(a,'2-tail p-value',header=TRUE) a<-table.element(a,'1-tail p-value',header=TRUE) a<-table.row.end(a) for (i in 1:k){ a<-table.row.start(a) a<-table.element(a,rownames(mysum$coefficients)[i],header=TRUE) a<-table.element(a,mysum$coefficients[i,1]) a<-table.element(a, round(mysum$coefficients[i,2],6)) a<-table.element(a, round(mysum$coefficients[i,3],4)) a<-table.element(a, round(mysum$coefficients[i,4],6)) a<-table.element(a, round(mysum$coefficients[i,4]/2,6)) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable2.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a, 'Multiple Linear Regression - Regression Statistics', 2, TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Multiple R',1,TRUE) a<-table.element(a, sqrt(mysum$r.squared)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a, mysum$r.squared) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a, mysum$adj.r.squared) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a, mysum$fstatistic[1]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, mysum$fstatistic[2]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, mysum$fstatistic[3]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a, 1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3])) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Multiple Linear Regression - Residual Statistics', 2, TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Residual Standard Deviation',1,TRUE) a<-table.element(a, mysum$sigma) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a, sum(myerror*myerror)) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable3.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a, 'Multiple Linear Regression - Actuals, Interpolation, and Residuals', 4, TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Time or Index', 1, TRUE) a<-table.element(a, 'Actuals', 1, TRUE) a<-table.element(a, 'Interpolation<br />Forecast', 1, TRUE) a<-table.element(a, 'Residuals<br />Prediction Error', 1, TRUE) a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,i, 1, TRUE) a<-table.element(a,x[i]) a<-table.element(a,x[i]-mysum$resid[i]) a<-table.element(a,mysum$resid[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable4.tab') if (n > n25) { a<-table.start() a<-table.row.start(a) a<-table.element(a,'Goldfeld-Quandt test for Heteroskedasticity',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'p-values',header=TRUE) a<-table.element(a,'Alternative Hypothesis',3,header=TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'breakpoint index',header=TRUE) a<-table.element(a,'greater',header=TRUE) a<-table.element(a,'2-sided',header=TRUE) a<-table.element(a,'less',header=TRUE) a<-table.row.end(a) for (mypoint in kp3:nmkm3) { a<-table.row.start(a) a<-table.element(a,mypoint,header=TRUE) a<-table.element(a,gqarr[mypoint-kp3+1,1]) a<-table.element(a,gqarr[mypoint-kp3+1,2]) a<-table.element(a,gqarr[mypoint-kp3+1,3]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable5.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Meta Analysis of Goldfeld-Quandt test for Heteroskedasticity',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Description',header=TRUE) a<-table.element(a,'# significant tests',header=TRUE) a<-table.element(a,'% significant tests',header=TRUE) a<-table.element(a,'OK/NOK',header=TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'1% type I error level',header=TRUE) a<-table.element(a,numsignificant1) a<-table.element(a,numsignificant1/numgqtests) if (numsignificant1/numgqtests < 0.01) dum <- 'OK' else dum <- 'NOK' a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'5% type I error level',header=TRUE) a<-table.element(a,numsignificant5) a<-table.element(a,numsignificant5/numgqtests) if (numsignificant5/numgqtests < 0.05) dum <- 'OK' else dum <- 'NOK' a<-table.element(a,dum) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'10% type I error level',header=TRUE) a<-table.element(a,numsignificant10) a<-table.element(a,numsignificant10/numgqtests) if (numsignificant10/numgqtests < 0.1) dum <- 'OK' else dum <- 'NOK' a<-table.element(a,dum) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable6.tab') }
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation