Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
149 96 68 86 12 139 70 39 70 8 148 88 32 71 11 158 114 62 108 13 128 69 33 64 11 224 176 52 119 10 159 114 62 97 7 105 121 77 129 10 159 110 76 153 15 167 158 41 78 12 165 116 48 80 12 159 181 63 99 10 119 77 30 68 10 176 141 78 147 14 54 35 19 40 6 91 80 31 57 12 163 152 66 120 14 124 97 35 71 11 137 99 42 84 8 121 84 45 68 12 153 68 21 55 15 148 101 25 137 13 221 107 44 79 11 188 88 69 116 12 149 112 54 101 7 244 171 74 111 11 148 137 80 189 7 92 77 42 66 12 150 66 61 81 12 153 93 41 63 13 94 105 46 69 9 156 131 39 71 11 132 102 34 64 12 161 161 51 143 15 105 120 42 85 12 97 127 31 86 6 151 77 39 55 5 131 108 20 69 13 166 85 49 120 11 157 168 53 96 6 111 48 31 60 12 145 152 39 95 10 162 75 54 100 6 163 107 49 68 12 59 62 34 57 11 187 121 46 105 6 109 124 55 85 12 90 72 42 103 12 105 40 50 57 8 83 58 13 51 10 116 97 37 69 11 42 88 25 41 7 148 126 30 49 12 155 104 28 50 13 125 148 45 93 14 116 146 35 58 12 128 80 28 54 6 138 97 41 74 14 49 25 6 15 10 96 99 45 69 12 164 118 73 107 11 162 58 17 65 10 99 63 40 58 7 202 139 64 107 12 186 50 37 70 7 66 60 25 53 12 183 152 65 136 12 214 142 100 126 10 188 94 28 95 10 104 66 35 69 12 177 127 56 136 12 126 67 29 58 12 76 90 43 59 8 99 75 59 118 10 139 128 50 82 5 78 41 3 50 10 162 146 59 102 10 108 69 27 65 12 159 186 61 90 11 74 81 28 64 9 110 85 51 83 12 96 54 35 70 11 116 46 29 50 10 87 106 48 77 12 97 34 25 37 10 127 60 44 81 9 106 95 64 101 11 80 57 32 79 12 74 62 20 71 7 91 36 28 60 11 133 56 34 55 12 74 54 31 44 6 114 64 26 40 9 140 76 58 56 15 95 98 23 43 10 98 88 21 45 11 121 35 21 32 12 126 102 33 56 12 98 61 16 40 12 95 80 20 34 11 110 49 37 89 9 70 78 35 50 11 102 90 33 56 12 86 45 27 46 12 130 55 41 76 14 96 96 40 64 8 102 43 35 74 10 100 52 28 57 9 94 60 32 45 10 52 54 22 30 9 98 51 44 62 10 118 51 27 51 12 99 38 17 36 11 48 41 12 34 9 50 146 45 61 11 150 182 37 70 12 154 192 37 69 12 109 263 108 145 7 68 35 10 23 12 194 439 68 120 12 158 214 72 147 12 159 341 143 215 10 67 58 9 24 15 147 292 55 84 10 39 85 17 30 15 100 200 37 77 10 111 158 27 46 15 138 199 37 61 9 101 297 58 178 15 131 227 66 160 12 101 108 21 57 13 114 86 19 42 12 165 302 78 163 12 114 148 35 75 8 111 178 48 94 9 75 120 27 45 15 82 207 43 78 12 121 157 30 47 12 32 128 25 29 15 150 296 69 97 11 117 323 72 116 12 71 79 23 32 6 165 70 13 50 14 154 146 61 118 12 126 246 43 66 12 149 196 51 86 12 145 199 67 89 11 120 127 36 76 12 109 153 44 75 12 132 299 45 57 12 172 228 34 72 12 169 190 36 60 8 114 180 72 109 8 156 212 39 76 12 172 269 43 65 12 68 130 25 40 11 89 179 56 58 10 167 243 80 123 11 113 190 40 71 12 115 299 73 102 13 78 121 34 80 12 118 137 72 97 12 87 305 42 46 10 173 157 61 93 10 2 96 23 19 11 162 183 74 140 8 49 52 16 78 12 122 238 66 98 9 96 40 9 40 12 100 226 41 80 9 82 190 57 76 11 100 214 48 79 15 115 145 51 87 8 141 119 53 95 8 165 222 29 49 11 165 222 29 49 11 110 159 55 80 11 118 165 54 86 13 158 249 43 69 7 146 125 51 79 12 49 122 20 52 8 90 186 79 120 8 121 148 39 69 4 155 274 61 94 11 104 172 55 72 10 147 84 30 43 7 110 168 55 87 12 108 102 22 52 11 113 106 37 71 9 115 2 2 61 10 61 139 38 51 8 60 95 27 50 8 109 130 56 67 11 68 72 25 30 12 111 141 39 70 10 77 113 33 52 10 73 206 43 75 12 151 268 57 87 8 89 175 43 69 11 78 77 23 72 8 110 125 44 79 10 220 255 54 121 14 65 111 28 43 9 141 132 36 58 9 117 211 39 57 10 122 92 16 50 13 63 76 23 69 12 44 171 40 64 13 52 83 24 38 8 131 266 78 90 3 101 186 57 96 8 42 50 37 49 12 152 117 27 56 11 107 219 61 102 9 77 246 27 40 12 154 279 69 100 12 103 148 34 67 12 96 137 44 78 10 175 181 34 55 13 57 98 39 59 9 112 226 51 96 12 143 234 34 86 11 49 138 31 38 14 110 85 13 43 11 131 66 12 23 9 167 236 51 77 12 56 106 24 48 8 137 135 19 26 15 86 122 30 91 12 121 218 81 94 14 149 199 42 62 12 168 112 22 74 9 140 278 85 114 9 88 94 27 52 13 168 113 25 64 13 94 84 22 31 15 51 86 19 38 11 48 62 14 27 7 145 222 45 105 10 66 167 45 64 11 85 82 28 62 14 109 207 51 65 14 63 184 41 58 13 102 83 31 76 12 162 183 74 140 8 86 89 19 68 13 114 225 51 80 9 164 237 73 71 12 119 102 24 76 13 126 221 61 63 11 132 128 23 46 11 142 91 14 53 13 83 198 54 74 12 94 204 51 70 12 81 158 62 78 10 166 138 36 56 9 110 226 59 100 10 64 44 24 51 13 93 196 26 52 13 104 83 54 102 9 105 79 39 78 11 49 52 16 78 12 88 105 36 55 8 95 116 31 98 12 102 83 31 76 12 99 196 42 73 12 63 153 39 47 9 76 157 25 45 12 109 75 31 83 12 117 106 38 60 11 57 58 31 48 12 120 75 17 50 6 73 74 22 56 7 91 185 55 77 10 108 265 62 91 12 105 131 51 76 10 117 139 30 68 12 119 196 49 74 9 31 78 16 29 3
Names of X columns:
LFM B CH H CONSSOFT
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