Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
149 11 8 7 152 15 18 18 139 19 18 20 148 16 12 9 158 24 24 19 128 15 16 12 224 17 19 16 159 19 16 17 105 19 15 9 159 28 28 28 167 26 21 20 165 15 18 16 159 26 22 22 119 16 19 17 176 24 22 12 54 25 25 18 91 22 20 20 163 15 16 12 124 21 19 16 137 22 18 16 121 27 26 21 153 26 24 15 148 26 20 17 221 22 19 17 188 21 19 17 149 22 23 18 244 20 18 15 148 21 16 20 92 20 18 13 150 22 21 21 153 21 20 12 94 8 15 6 156 22 19 13 146 18 27 6 132 20 19 19 161 24 7 12 105 17 20 14 97 20 20 13 151 23 19 12 131 20 19 17 166 22 20 19 157 19 18 10 111 15 14 10 145 20 17 11 162 22 17 11 163 17 8 10 59 14 9 7 187 24 22 22 109 17 20 12 90 23 20 18 105 25 22 20 83 16 22 9 116 18 22 16 42 20 16 14 148 18 14 11 155 23 24 20 125 24 21 17 116 23 20 14 128 13 20 8 138 20 18 16 49 20 14 11 96 19 19 10 164 22 24 15 162 22 19 15 99 15 16 10 202 17 16 10 186 19 16 18 66 20 14 10 183 22 22 22 214 21 21 16 188 21 15 10 104 16 14 7 177 20 15 16 126 21 14 16 76 20 20 16 99 23 21 22 157 15 17 13 139 18 14 5 78 22 19 18 162 16 16 10 108 17 13 8 159 24 26 16 74 13 13 8 110 19 18 16 96 20 15 14 116 22 18 15 87 19 21 9 97 21 17 21 127 15 18 7 106 21 20 17 80 24 18 18 74 22 25 16 91 20 20 16 133 21 19 14 74 19 18 15 114 14 12 8 140 25 22 22 95 11 16 5 98 17 18 13 121 22 23 22 126 20 20 18 98 22 20 15 95 15 16 11 110 23 22 19 70 20 19 19 102 22 23 21 86 16 6 4 130 25 19 17 96 18 24 10 102 19 19 13 100 25 15 15 94 21 18 11 52 22 18 20 98 21 22 13 118 22 23 18 99 23 18 20 48 20 17 15 50 6 6 4 150 15 22 9 154 18 20 18 109 24 16 12 68 22 16 17 194 21 17 12 158 23 20 16 159 20 23 17 67 20 18 14 147 18 13 13 39 25 22 20 100 16 20 16 111 20 20 15 138 14 13 10 101 22 16 16 131 26 25 21 101 20 16 15 114 17 15 16 165 22 19 19 114 22 19 9 111 20 24 19 75 17 9 7 82 22 22 23 121 17 15 14 32 22 22 10 150 21 22 16 117 25 24 12 71 11 12 10 165 19 21 7 154 24 25 20 126 17 26 9 138 22 19 14 149 22 21 12 145 17 14 10 120 26 28 19 138 19 16 16 109 20 21 11 132 19 16 15 172 21 16 14 169 24 25 11 114 21 21 14 156 19 22 15 172 13 9 7 68 24 20 22 89 28 19 19 167 27 24 22 113 22 22 11 115 23 22 19 78 19 12 9 118 18 17 11 87 23 18 17 173 21 10 12 2 22 22 17 162 17 24 10 49 15 18 17 122 21 18 13 96 20 23 11 100 26 21 19 82 19 21 21 100 28 28 24 115 21 17 13 141 19 21 16 165 22 21 13 165 21 20 15 110 20 18 15 118 19 17 11 158 11 7 7 146 17 17 13 49 19 14 13 90 20 18 12 121 17 14 8 155 21 23 7 104 21 20 17 147 12 14 9 110 23 17 18 108 22 21 17 113 22 23 17 115 21 24 18 61 20 21 12 60 18 14 14 109 21 24 22 68 24 16 19 111 22 21 21 77 20 8 10 73 17 17 16 151 19 18 11 89 16 17 15 78 19 16 12 110 23 22 21 220 8 17 22 65 22 21 20 141 23 20 15 117 15 20 9 122 17 19 15 63 21 8 14 44 25 19 11 52 18 11 9 62 23 15 18 131 20 13 12 101 21 18 11 42 21 19 14 152 24 23 10 107 22 20 18 77 22 22 11 154 23 19 14 103 17 16 16 96 15 11 11 154 24 11 8 175 22 21 16 57 19 14 13 112 18 21 12 143 21 20 17 49 20 21 23 110 19 20 14 131 19 19 10 167 16 19 16 56 18 18 11 137 23 20 16 86 22 21 19 121 23 22 17 149 20 19 12 168 24 23 17 140 25 16 11 88 25 23 19 168 20 18 12 94 23 23 8 51 21 20 17 48 23 20 13 145 23 23 17 66 11 13 7 85 21 21 23 109 27 26 18 63 19 18 13 102 21 19 17 162 16 18 13 128 22 19 13 86 21 18 8 114 22 19 16 164 16 13 14 119 18 10 13 126 23 21 19 132 24 24 15 142 20 21 15 83 20 23 8 94 18 18 14 81 4 11 7 166 14 16 11 110 22 20 17 64 17 20 19 93 23 26 17 104 20 21 12 105 18 12 12 49 19 15 18 88 20 18 16 95 15 14 15 102 24 18 20 99 21 16 16 63 19 19 12 76 19 7 10 109 27 21 28 117 23 24 19 57 23 21 18 120 20 20 19 73 17 22 8 91 21 17 17 108 23 19 16 105 22 20 18 117 16 16 12 119 20 20 17 31 16 16 13
Names of X columns:
LFM 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
par3 <- 'No Linear Trend' par2 <- 'Do not include Seasonal Dummies' par1 <- '1' 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