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