Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1 1901 61 17 56 84 4 21 51 2 2509 74 19 73 47 3 15 45 3 2114 57 18 62 63 3 17 44 4 1331 50 15 42 28 3 20 42 5 1399 48 15 59 22 2 12 38 6 7333 2 12 27 18 6 4 38 7 1170 31 20 78 27 5 11 35 8 1507 61 14 56 37 5 12 35 9 1107 36 15 59 20 5 9 34 10 2051 46 13 51 67 5 14 33 11 1290 30 17 47 28 4 11 32 12 820 49 10 35 45 3 14 31 13 1502 14 13 47 15 5 4 30 14 1451 12 12 47 23 6 7 30 15 1178 54 16 55 30 6 9 30 16 1514 44 15 54 27 2 14 29 17 883 40 15 60 43 5 13 29 18 1405 57 15 55 36 5 11 29 19 927 29 12 48 28 5 9 28 20 1352 32 13 47 28 9 8 27 21 1314 28 12 47 22 4 9 27 22 1307 40 15 52 27 4 11 27 23 1243 54 12 48 24 5 7 26 24 1232 56 12 48 52 3 15 26 25 1097 19 9 27 12 0 4 26 26 1100 67 12 12 24 5 10 26 27 1316 25 13 51 10 3 10 26 28 903 42 16 58 71 4 13 25 29 929 28 15 60 12 2 10 25 30 1049 57 13 46 24 5 10 25 31 1372 28 12 45 22 11 6 24 32 1470 35 13 42 21 5 8 24 33 821 10 12 41 13 3 7 24 34 1239 30 12 47 28 4 11 24 35 1384 23 8 32 19 5 10 24 36 820 32 15 56 29 5 11 24 37 1462 24 12 42 12 2 10 24 38 1202 42 12 41 32 6 8 23 39 1091 33 12 47 21 3 10 23 40 1228 19 14 47 19 4 5 23 41 707 17 15 49 15 8 5 23 42 868 49 15 52 14 14 5 23 43 1165 30 12 42 34 11 9 22 44 1106 3 13 55 8 8 2 22 45 1429 56 12 48 27 3 9 22 46 1671 37 13 48 31 3 13 22 47 1579 26 12 38 21 11 7 22 48 774 19 12 48 10 3 5 21 49 934 22 13 50 21 4 7 21 50 825 53 12 39 19 3 8 21 51 1375 35 12 48 27 5 8 21 52 968 12 9 36 17 6 5 21 53 1156 34 13 49 30 8 5 21 54 1374 28 13 39 19 3 10 21 55 1224 38 12 41 17 3 5 21 56 804 38 15 45 24 5 10 21 57 998 45 15 60 36 5 10 21 58 1112 15 13 45 16 3 7 21 59 1153 35 14 41 16 3 10 20 60 613 27 14 52 30 3 9 20 61 729 23 12 46 18 5 10 20 62 813 33 12 39 26 3 10 20 63 912 23 9 32 17 3 5 20 64 1178 26 14 52 28 6 8 20 65 1201 32 16 54 20 4 6 19 66 1165 35 15 51 27 3 7 19 67 705 18 13 52 13 13 6 18 68 814 18 16 57 10 5 3 17 69 1082 41 12 47 29 6 9 17 70 885 39 12 45 34 5 11 17 71 837 56 12 41 30 3 9 17 72 586 35 12 43 16 4 10 16 73 913 37 10 31 22 4 9 16 74 547 26 15 32 22 7 7 15 75 758 33 12 41 31 4 6 15 76 848 7 9 27 10 5 6 15 77 634 16 10 40 7 7 5 15 78 501 13 13 46 10 3 5 15 79 849 54 12 32 55 6 8 15 80 733 30 13 9 25 8 7 15 81 634 9 16 64 9 5 5 15 82 1010 35 15 30 31 5 10 15 83 778 0 12 46 0 0 0 15 84 480 40 12 37 24 3 10 15 85 848 22 12 22 14 5 6 15 86 714 29 12 20 11 3 6 14 87 871 25 12 21 8 8 4 14 88 776 17 14 44 9 9 3 14 89 815 32 12 24 18 9 7 14 90 811 40 12 33 14 4 5 14 91 529 24 12 45 27 2 8 13 92 642 18 13 35 10 0 0 13 93 562 15 8 31 16 3 5 13 94 626 17 16 20 13 7 5 13 95 636 28 12 13 10 5 5 13 96 935 18 11 33 16 3 5 13 97 473 16 15 58 11 3 6 12 98 836 28 13 26 8 3 5 12 99 938 17 12 36 29 7 6 12 100 656 25 13 32 12 4 4 12 101 566 2 13 34 1 0 0 12 102 765 10 12 15 26 5 8 12 103 705 9 12 40 5 5 2 11 104 558 7 12 37 5 5 2 11 105 582 27 14 26 24 6 8 11 106 608 25 12 31 19 6 3 11 107 567 16 16 47 10 5 3 11 108 434 28 8 21 6 6 3 11 109 479 7 8 21 61 0 3 11 110 488 0 5 9 25 25 1 10 111 507 16 9 28 7 2 2 10 112 394 10 11 24 10 5 2 10 113 504 0 4 15 3 3 1 9 114 368 2 8 19 1 1 2 9 115 386 5 13 35 38 5 7 9 116 451 36 13 45 13 4 4 9 117 580 10 12 20 2 0 1 9 118 565 43 13 1 8 4 6 9 119 510 14 12 29 30 10 3 9 120 495 12 12 33 11 6 2 8 121 596 15 10 32 69 23 3 8 122 412 8 12 11 2 0 2 8 123 338 39 5 10 23 6 5 7 124 446 10 13 18 8 4 4 7 125 418 0 12 41 0 0 0 7 126 335 7 6 0 2 0 0 6 127 349 10 9 10 4 2 3 6 128 308 3 12 24 4 4 2 5 129 466 8 15 28 0 0 0 5 130 228 0 11 38 9 9 1 5 131 428 8 3 4 5 5 3 5 132 242 1 8 25 0 0 0 5 133 352 0 12 40 0 0 0 5 134 244 8 0 0 13 4 4 5 135 269 3 9 23 1 0 1 5 136 242 0 4 13 0 0 0 4 137 291 0 14 6 39 0 2 4 138 213 0 9 31 10 0 0 4 139 135 0 0 0 1 0 1 3 140 210 3 1 3 3 3 3 3
Names of X columns:
A B C D E F G H I
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
Do not include Seasonal Dummies
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
No Linear Trend
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