Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
272545 483 96 140824 186099 165 179444 429 71 110459 113854 135 228916 692 70 105079 99776 121 218443 1137 134 112098 106194 148 171533 380 67 43929 100792 73 70849 179 8 76173 47552 49 517243 2302 149 187326 250931 185 33186 111 1 22807 6853 5 217320 740 83 144408 115466 125 213274 595 82 66485 110896 93 309323 806 92 79089 169351 154 242739 691 117 81625 94853 98 194882 737 56 68788 72591 70 364569 1176 139 103297 101345 148 255231 701 80 69446 113713 100 384524 1696 175 114948 165354 150 332430 827 114 167949 164263 197 343085 1196 100 125081 135213 114 176082 507 103 125818 111669 169 266736 689 135 136588 134163 200 278265 837 123 112431 140303 148 442703 1270 87 103037 150773 140 180393 462 66 82317 111848 74 189897 601 103 118906 102509 128 238953 1281 144 83515 96785 140 238550 1033 113 104581 116136 116 267318 1062 99 103129 158376 147 277501 632 117 83243 153990 132 155915 559 57 37110 64057 70 365373 1139 141 113344 230054 144 286083 948 125 139165 184531 155 236819 693 47 86652 114198 165 342856 851 140 112302 198299 161 101014 343 43 69652 33750 31 396684 1259 138 119442 189723 199 273950 1186 83 69867 100826 78 425253 1329 112 101629 188355 121 227636 640 79 70168 104470 112 115658 284 33 31081 58391 41 375992 1272 137 103925 164808 158 329639 1499 123 92622 134097 123 186648 699 76 79011 80238 104 206196 668 78 93487 133252 94 182286 486 68 64520 54518 73 153778 1022 50 93473 121850 52 455401 2072 101 114360 79367 71 78800 330 20 33032 56968 21 208277 658 101 96125 106314 155 358127 1380 149 151911 191889 174 176357 885 99 89256 104864 136 224649 593 95 95676 160792 128 24188 218 8 5950 15049 7 380576 840 88 149695 191179 165 65029 255 21 32551 25109 21 101097 454 30 31701 45824 35 279128 1112 97 100087 129711 137 328024 678 130 169707 210012 174 354352 1167 132 150491 194679 257 367112 1076 161 120192 197680 207 261528 864 89 95893 81180 103 388928 1326 160 151715 197765 171 304468 1145 139 176225 214738 279 272297 1197 102 59900 96252 83 264889 931 92 104767 124527 130 229585 562 52 114799 153242 131 225460 447 107 72128 145707 126 203663 605 93 143592 113963 158 239998 839 85 89626 134904 138 238482 853 137 131072 114268 200 175816 625 143 126817 94333 104 239337 865 99 81351 102204 111 73566 385 22 22618 23824 26 242622 718 78 88977 111563 115 194855 747 83 92059 91313 127 209049 732 131 81897 89770 140 363250 995 140 108146 100125 121 353115 1149 142 126372 165278 183 217036 575 80 249771 181712 68 208824 708 133 71154 80906 112 195793 684 95 71571 75881 103 153654 622 62 55918 83963 63 475859 1258 161 160141 175721 166 145943 653 30 38692 68580 38 287359 688 118 102812 136323 163 80953 437 49 56622 55792 59 150216 822 52 15986 25157 27 179317 458 76 123534 100922 108 393904 1537 85 108535 118845 88 343190 955 146 93879 170492 92 179811 1045 165 144551 81716 170 278439 832 83 56750 115750 98 274449 703 165 127654 105590 205 190312 600 48 65594 92795 96 280628 1119 149 59938 82390 107 329007 967 75 146975 135599 150 189654 565 83 161100 119595 132 259365 652 110 168553 162519 176 297464 801 164 183500 211381 213 399815 1349 154 165986 189944 208 402068 1437 165 184923 226168 307 291970 868 121 140358 117495 125 296670 860 150 149959 195894 208 189276 663 73 57224 80684 73 43287 214 13 43750 19630 49 185483 717 89 48029 88634 82 250254 830 105 104978 139292 206 268391 1174 129 100046 128602 112 314131 1067 169 101047 135848 139 153109 408 28 197426 178377 60 161884 943 118 160902 106330 70 334485 648 79 147172 178303 112 300526 690 147 109432 116938 142 23623 156 12 1168 5841 11 195817 779 146 83248 106020 130 61857 192 23 25162 24610 31 163871 458 83 45724 74151 132 428191 1213 163 110529 232241 219 21054 146 4 855 6622 4 252805 866 81 101382 127097 102 31961 200 18 14116 13155 39 331849 1269 114 89506 160501 125 243164 702 76 135356 91502 121 175953 506 55 116066 24469 42 152043 670 44 144244 88229 111 38214 276 16 8773 13983 16 224597 752 81 102153 80716 70 357602 1021 137 117440 157384 162 198104 481 50 104128 122975 173 418356 1605 142 134238 191469 171 338606 873 157 134047 231257 172 412513 1173 141 279488 258287 254 187992 473 71 79756 122531 90 102424 401 42 66089 61394 50 302158 977 94 102070 86480 113 437141 1517 117 146760 195791 187 143860 546 63 154771 18284 16 395382 1755 127 165933 147581 175 162422 707 55 64593 72558 90 278077 632 117 92280 147341 140 282410 897 110 67150 114651 145 219493 619 39 128692 100187 141 384177 1606 95 124089 130332 125 246963 811 128 125386 134218 241 173260 716 41 37238 10901 16 333967 988 146 140015 145758 175 168994 720 147 150047 75767 132 253330 1023 119 154451 134969 154 305217 829 185 156349 169216 198 1 0 0 0 0 0 14688 85 4 6023 7953 5 98 0 0 0 0 0 455 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 251752 747 72 84601 105406 125 409163 1128 157 68946 174586 174 0 0 0 0 0 0 203 0 0 0 0 0 7199 74 7 1644 4245 6 46660 259 12 6179 21509 13 17547 69 0 3926 7670 3 116969 290 37 52789 15673 35 969 0 0 0 0 0 229447 661 59 100350 75882 80
Names of X columns:
Y X1 X2 X3 X4 X5
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
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation