Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
96 11 8 7 75 15 18 18 70 19 18 20 88 16 12 9 114 24 24 19 69 15 16 12 176 17 19 16 114 19 16 17 121 19 15 9 110 28 28 28 158 26 21 20 116 15 18 16 181 26 22 22 77 16 19 17 141 24 22 12 35 25 25 18 80 22 20 20 152 15 16 12 97 21 19 16 99 22 18 16 84 27 26 21 68 26 24 15 101 26 20 17 107 22 19 17 88 21 19 17 112 22 23 18 171 20 18 15 137 21 16 20 77 20 18 13 66 22 21 21 93 21 20 12 105 8 15 6 131 22 19 13 89 18 27 6 102 20 19 19 161 24 7 12 120 17 20 14 127 20 20 13 77 23 19 12 108 20 19 17 85 22 20 19 168 19 18 10 48 15 14 10 152 20 17 11 75 22 17 11 107 17 8 10 62 14 9 7 121 24 22 22 124 17 20 12 72 23 20 18 40 25 22 20 58 16 22 9 97 18 22 16 88 20 16 14 126 18 14 11 104 23 24 20 148 24 21 17 146 23 20 14 80 13 20 8 97 20 18 16 25 20 14 11 99 19 19 10 118 22 24 15 58 22 19 15 63 15 16 10 139 17 16 10 50 19 16 18 60 20 14 10 152 22 22 22 142 21 21 16 94 21 15 10 66 16 14 7 127 20 15 16 67 21 14 16 90 20 20 16 75 23 21 22 96 15 17 13 128 18 14 5 41 22 19 18 146 16 16 10 69 17 13 8 186 24 26 16 81 13 13 8 85 19 18 16 54 20 15 14 46 22 18 15 106 19 21 9 34 21 17 21 60 15 18 7 95 21 20 17 57 24 18 18 62 22 25 16 36 20 20 16 56 21 19 14 54 19 18 15 64 14 12 8 76 25 22 22 98 11 16 5 88 17 18 13 35 22 23 22 102 20 20 18 61 22 20 15 80 15 16 11 49 23 22 19 78 20 19 19 90 22 23 21 45 16 6 4 55 25 19 17 96 18 24 10 43 19 19 13 52 25 15 15 60 21 18 11 54 22 18 20 51 21 22 13 51 22 23 18 38 23 18 20 41 20 17 15 146 6 6 4 182 15 22 9 192 18 20 18 263 24 16 12 35 22 16 17 439 21 17 12 214 23 20 16 341 20 23 17 58 20 18 14 292 18 13 13 85 25 22 20 200 16 20 16 158 20 20 15 199 14 13 10 297 22 16 16 227 26 25 21 108 20 16 15 86 17 15 16 302 22 19 19 148 22 19 9 178 20 24 19 120 17 9 7 207 22 22 23 157 17 15 14 128 22 22 10 296 21 22 16 323 25 24 12 79 11 12 10 70 19 21 7 146 24 25 20 246 17 26 9 145 22 19 14 196 22 21 12 199 17 14 10 127 26 28 19 91 19 16 16 153 20 21 11 299 19 16 15 228 21 16 14 190 24 25 11 180 21 21 14 212 19 22 15 269 13 9 7 130 24 20 22 179 28 19 19 243 27 24 22 190 22 22 11 299 23 22 19 121 19 12 9 137 18 17 11 305 23 18 17 157 21 10 12 96 22 22 17 183 17 24 10 52 15 18 17 238 21 18 13 40 20 23 11 226 26 21 19 190 19 21 21 214 28 28 24 145 21 17 13 119 19 21 16 222 22 21 13 222 21 20 15 159 20 18 15 165 19 17 11 249 11 7 7 125 17 17 13 122 19 14 13 186 20 18 12 148 17 14 8 274 21 23 7 172 21 20 17 84 12 14 9 168 23 17 18 102 22 21 17 106 22 23 17 2 21 24 18 139 20 21 12 95 18 14 14 130 21 24 22 72 24 16 19 141 22 21 21 113 20 8 10 206 17 17 16 268 19 18 11 175 16 17 15 77 19 16 12 125 23 22 21 255 8 17 22 111 22 21 20 132 23 20 15 211 15 20 9 92 17 19 15 76 21 8 14 171 25 19 11 83 18 11 9 119 23 15 18 266 20 13 12 186 21 18 11 50 21 19 14 117 24 23 10 219 22 20 18 246 22 22 11 279 23 19 14 148 17 16 16 137 15 11 11 130 24 11 8 181 22 21 16 98 19 14 13 226 18 21 12 234 21 20 17 138 20 21 23 85 19 20 14 66 19 19 10 236 16 19 16 106 18 18 11 135 23 20 16 122 22 21 19 218 23 22 17 199 20 19 12 112 24 23 17 278 25 16 11 94 25 23 19 113 20 18 12 84 23 23 8 86 21 20 17 62 23 20 13 222 23 23 17 167 11 13 7 82 21 21 23 207 27 26 18 184 19 18 13 83 21 19 17 183 16 18 13 85 22 19 13 89 21 18 8 225 22 19 16 237 16 13 14 102 18 10 13 221 23 21 19 128 24 24 15 91 20 21 15 198 20 23 8 204 18 18 14 158 4 11 7 138 14 16 11 226 22 20 17 44 17 20 19 196 23 26 17 83 20 21 12 79 18 12 12 52 19 15 18 105 20 18 16 116 15 14 15 83 24 18 20 196 21 16 16 153 19 19 12 157 19 7 10 75 27 21 28 106 23 24 19 58 23 21 18 75 20 20 19 74 17 22 8 185 21 17 17 265 23 19 16 131 22 20 18 139 16 16 12 196 20 20 17 78 16 16 13
Names of X columns:
B I1 I2 I3
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, signif(mysum$coefficients[i,1],6), 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,signif(mysum$coefficients[i,1],6)) a<-table.element(a, signif(mysum$coefficients[i,2],6)) a<-table.element(a, signif(mysum$coefficients[i,3],4)) a<-table.element(a, signif(mysum$coefficients[i,4],6)) a<-table.element(a, signif(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, signif(sqrt(mysum$r.squared),6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a, signif(mysum$r.squared,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a, signif(mysum$adj.r.squared,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[1],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[2],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[3],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a, signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6)) 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, signif(mysum$sigma,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a, signif(sum(myerror*myerror),6)) 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,signif(x[i],6)) a<-table.element(a,signif(x[i]-mysum$resid[i],6)) a<-table.element(a,signif(mysum$resid[i],6)) 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,signif(gqarr[mypoint-kp3+1,1],6)) a<-table.element(a,signif(gqarr[mypoint-kp3+1,2],6)) a<-table.element(a,signif(gqarr[mypoint-kp3+1,3],6)) 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,signif(numsignificant1,6)) a<-table.element(a,signif(numsignificant1/numgqtests,6)) 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,signif(numsignificant5,6)) a<-table.element(a,signif(numsignificant5/numgqtests,6)) 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,signif(numsignificant10,6)) a<-table.element(a,signif(numsignificant10/numgqtests,6)) 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