Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
61 80 41 568 10173 81 111 50 1110 10083 87 122 46 338 10258 87 131 36 555 10154 136 192 67 281 10207 147 188 104 571 10133 168 216 115 322 10197 185 238 125 503 10184 137 173 97 1078 10163 125 160 88 582 10104 64 93 27 926 10127 45 67 19 491 10164 35 60 9 504 10219 -4 32 -47 314 10177 88 126 46 269 10138 85 131 36 252 10164 95 134 51 342 10223 128 162 90 1464 10122 186 230 142 921 10161 182 232 119 115 10199 151 200 92 789 10160 106 143 70 495 10157 60 85 30 1279 10113 44 66 19 391 10276 30 54 2 352 10303 54 81 21 340 10232 72 100 41 715 10140 88 126 46 425 10121 153 204 94 413 10188 168 218 114 935 10164 181 227 130 680 10165 180 220 141 1472 10121 149 220 109 767 10166 84 120 46 1215 10091 85 110 58 1113 10121 42 67 17 711 10180 54 81 22 742 10197 30 52 5 225 10289 96 106 17 107 10220 110 156 57 457 10106 141 187 91 448 10141 159 204 106 385 10165 164 204 125 1518 10152 155 196 111 495 10188 135 204 99 1283 10110 93 124 63 751 10144 28 53 3 674 10206 56 77 30 1705 10045 56 77 30 894 10100 22 50 -9 309 10147 76 105 42 745 10149 83 125 38 806 10116 121 165 73 423 10138 151 194 102 506 10183 208 263 149 148 10174 179 225 132 494 10143 139 263 108 1794 10120 99 140 58 1329 10143 103 127 66 289 10181 57 86 24 1213 10161 44 71 15 1263 10121 70 95 43 910 10095 58 95 17 934 10114 91 133 47 228 10173 126 178 63 366 10164 146 160 101 45 10174 199 250 142 459 10155 194 251 131 253 10182 145 250 107 999 10109 131 173 85 182 10198 74 103 38 483 10167 -3 21 -36 401 10178 7 29 -15 47 10143 10 39 -21 665 10127 34 71 -3 102 10183 94 148 35 22 10178 105 144 62 445 10142 151 199 91 378 10207 162 206 110 419 10176 175 224 127 1046 10145 128 206 79 531 10172 115 152 76 809 10157 62 88 32 1416 10086 11 35 -18 369 10151 -7 23 -39 20 10236 64 92 30 882 10160 80 117 43 262 10233 77 120 26 186 10212 127 173 74 763 10150 158 202 111 1038 10100 173 217 123 558 10178 206 256 151 335 10161 147 217 95 242 10217 103 143 59 898 10173 73 95 47 498 10067 52 77 21 757 10117 52 76 23 843 10149 68 100 33 133 10238 77 108 39 1035 10211 94 132 61 1117 10030 147 195 91 341 10165 160 198 123 1304 10142 166 204 124 566 10126 167 212 112 756 10176 155 204 122 1761 10095 104 129 70 1469 10105 44 73 11 1370 10172 53 77 29 795 10180 56 80 26 920 10126 36 64 2 754 10154 76 109 38 1034 10107 99 138 58 617 10133 142 185 92 706 10158 150 198 97 832 10173 190 237 138 393 10171 176 223 127 1551 10130 175 237 136 675 10105 112 146 80 1225 10154 73 102 38 737 10206 52 77 23 1444 10078 48 70 22 452 10233 61 86 30 1157 10179 68 98 32 718 10197 97 141 55 419 10075 146 195 96 898 10147 160 205 110 417 10195 155 191 117 1207 10129 175 226 125 163 10175 163 191 127 643 10128 117 147 86 1333 10099 82 100 62 1625 10015 55 74 33 970 10079 32 56 6 787 10112 48 77 17 995 10170 53 80 24 669 10048 82 120 44 861 10119 139 186 85 247 10180 150 196 95 349 10168 184 229 140 994 10141 185 229 139 1213 10149 138 229 104 2540 10117 147 176 117 388 10140 77 104 42 907 10216 32 61 -4 778 10227 48 72 23 729 10209 72 99 42 1428 10097 76 113 34 462 10176 94 140 44 528 10158 133 174 89 325 10132 164 209 116 777 10154 174 205 133 686 10145 187 229 141 1464 10153 149 215 104 438 10199 102 136 63 792 10111 86 113 52 1089 10071 35 57 13 920 10151 31 55 2 680 10148 28 66 -10 206 10206 75 125 23 177 10235 102 149 45 438 10170 133 176 83 800 10164 178 230 114 278 10161 190 238 137 396 10155 190 245 132 101 10181 147 238 87 785 10200 83 124 39 724 10133 83 111 52 556 10139 46 72 18 905 10169 40 63 12 1199 10080 50 78 19 688 10191 61 100 18 443 10202 102 149 49 710 10128 117 166 61 273 10160 158 201 105 752 10170 170 214 123 852 10158 190 231 150 1838 10110 155 214 113 765 10181 117 151 84 453 10093 68 97 33 792 10206 40 68 7 490 10180 56 81 30 562 10202 28 55 -2 731 10193 66 99 28 315 10158 103 146 57 623 10139 122 170 68 423 10167 166 218 111 726 10188 176 218 132 1137 10147 164 207 115 773 10173 160 218 114 971 10180 139 178 102 547 10166 75 105 40 1004 10149 44 67 16 538 10167 22 47 -7 149 10243 32 55 11 504 10148 42 73 7 619 10105 86 124 47 176 10144 140 185 93 908 10136 163 213 104 290 10208 222 278 159 155 10192 166 205 129 2681 10111 183 278 140 179 10139 140 171 100 1243 10112 98 125 67 973 10147 69 92 44 860 10205 75 96 49 1029 10154 63 92 32 772 10087 81 118 40 805 10151 126 185 63 3 10217 139 183 92 1237 10106 171 215 133 939 10117 170 207 134 1799 10115 173 214 126 534 10148 144 207 102 1042 10191 105 142 64 270 10238 75 102 43 724 10183 41 66 16 783 10206 68 87 43 648 10138 53 90 11 465 10238 61 90 26 1292 10052 87 133 40 318 10110 155 205 94 747 10156 159 201 113 298 10160 180 220 137 1145 10141 175 210 140 1456 10116 138 220 93 612 10176 105 136 67 1136 10146 73 95 44 903 1125 26 52 -3 609 10180 12 40 -14 532 10133 35 60 4 672 10141 64 100 25 568 10141 115 169 57 234 10140 138 184 87 778 10187 138 202 107 436 10169 182 226 140 795 10128 191 239 136 298 10164 155 226 112 284 10208 113 149 70 852 10165 98 121 72 1307 10036 29 50 3 1166 10064
Names of X columns:
Temp Max Min Neerslag Luchtdruk
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
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
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation