Wessa.net

Send output to:

Data X:
48 3 0 38 4 0 31 4 5 31 4 4 106 5 8 81 5 12 21 6 15 35 6 12 24 6 2 121 7 13 143 7 6 56 7 8 52 8 5 52 8 15 73 9 11 109 10 5 56 10 17 44 10 11 43 10 12 23 10 16 285 11 12 162 11 2 68 11 8 92 11 12 62 11 11 42 11 9 183 12 12 115 12 8 114 12 6 73 12 20 502 13 9 151 13 13 113 13 10 101 13 15 67 13 22 49 13 14 89 14 5 72 14 22 235 15 13 228 15 25 254 15 19 85 15 30 38 15 4 401 16 8 174 16 10 70 16 17 181 16 13 173 16 15 145 16 19 123 16 18 372 17 29 150 17 16 121 17 17 114 17 6 94 17 7 176 18 61 214 18 11 201 18 21 91 18 18 47 18 6 212 19 17 536 19 18 112 19 21 110 19 21 183 20 24 233 20 19 157 20 22 144 20 12 37 20 35 109 21 18 107 21 18 94 21 22 256 22 14 156 22 8 149 22 19 129 22 12 74 23 11 153 23 24 139 25 29 137 25 24 122 25 24 236 26 31 232 26 22 161 27 41 195 27 20 145 27 28 191 28 28 131 28 53 482 29 22 186 29 34 165 29 11 147 29 13 145 29 35 118 30 33 169 30 22 109 30 24 98 30 28 215 31 30 170 32 17 171 32 20 132 32 27 66 32 16 58 32 41 198 33 9 188 33 21 146 33 20 99 33 20 255 34 29 328 34 36 266 34 69 201 34 22 183 34 25 169 34 15 278 35 21 35 33 97 35 49 335 36 40 224 36 113 178 36 36 153 36 31 121 37 34 429 37 35 103 37 27 179 38 65 187 38 19 162 38 22 225 39 69 31 39 48 282 41 42 279 41 58 221 41 33 217 41 31 199 41 34 415 42 56 114 42 25 157 42 37 355 43 35 265 43 51 304 43 28 165 43 34 239 44 72 159 45 27 93 45 18 170 46 17 144 46 100 369 47 31 148 47 53 209 47 36 179 48 49 125 48 64 98 48 109 140 48 43 124 48 56 185 49 45 125 49 40 344 50 54 222 50 41 150 50 46 146 50 45 215 50 37 99 50 72 448 51 47 175 51 140 175 51 63 345 52 60 449 52 62 156 53 34 144 53 39 474 54 60 189 54 43 136 54 40 287 54 43 177 54 129 156 55 46 129 55 42 472 58 53 232 58 40 141 58 96 306 59 36 144 59 58 336 59 59 181 59 48 121 59 74 173 60 47 168 61 94 398 62 65 392 62 62 434 62 32 286 62 31 153 62 48 48 62 64 41 62 16 194 63 51 324 65 64 455 65 100 295 66 86 188 66 113 95 66 38 1 182 68 62 264 68 48 492 69 46 423 70 43 201 70 68 186 70 72 356 71 73 326 72 82 192 73 82 511 73 81 458 74 62 359 74 54 378 74 77 232 75 63 483 75 39 330 75 201 324 75 58 204 75 96 163 77 66 236 78 113 542 79 85 326 79 58 347 80 51 456 80 152 380 81 68 150 81 159 185 83 49 434 83 65 284 83 45 574 84 55 406 84 63 352 85 80 305 85 113 208 85 97 343 86 202 204 86 87 145 88 45 265 89 61 539 89 83 291 89 45 343 90 71 163 90 73 100 90 48 883 91 80 452 91 117 280 91 168 205 92 127 433 93 91 372 94 59 202 94 184 321 96 49 240 96 114 243 97 119 436 99 82 239 99 85 589 100 71 238 102 79 956 103 136 657 105 94 372 105 235 222 105 185 397 106 114 1 003 107 121 509 108 77 388 108 171 490 109 67 259 109 77 355 110 147 253 111 52 488 113 99 160 115 166 307 115 288 554 116 143 505 118 180 1 083 120 76 426 120 111 1 000 123 85 323 126 109 1 061 127 95 259 131 98 737 132 167 559 132 101 596 138 76 537 140 95 719 141 111 489 141 95 478 141 106 337 142 74 856 145 145 449 146 77 359 148 158 469 148 140 434 150 151 357 150 118 768 153 111 373 155 475 581 156 236 587 157 159 526 158 195 195 158 58 614 160 99 553 160 135 558 160 93 417 160 311 921 162 158 476 163 176 787 164 131 908 166 100 552 168 125 850 170 150 582 173 192 514 174 147 386 174 152 530 176 171 546 180 201 983 181 148 495 181 203 1 057 182 172 548 182 274 522 190 419 791 194 176 994 196 174 569 196 219 764 197 119 602 198 192 831 199 205 568 200 111 948 206 175 351 206 165 367 211 266 1 001 215 200 708 215 303 644 224 412 467 225 191 991 229 127 586 232 288 992 236 141 717 240 189 1 139 251 222 563 251 263 806 255 300 549 256 419 1 157 262 346 528 262 369 1 533 267 235 756 269 256 1 039 271 430 1 070 275 172 1 053 278 351 784 278 311 756 283 208 1 003 285 243 1 155 298 292 2 548 301 277 1 057 303 259 850 309 245 632 314 357 501 325 415 1 528 338 250 1 776 338 343 921 346 505 414 356 342 1 219 360 107 1 738 368 273 1 084 375 306 767 386 725 2 372 388 222 2 036 391 311 1 729 393 259 1 393 402 250 847 404 552 222 407 99 1 076 408 565 1 062 409 338 416 410 160 343 417 109 1 813 424 312 1 920 435 318 2 392 436 377 156 443 221 2 230 449 547 564 451 566 1 549 456 245 5 091 457 300 1 370 462 403 622 469 195 501 479 220 1 187 480 753 1 217 481 868 1 278 487 388 2 251 497 399 1 156 520 478 1 357 525 441 2 116 534 434 2 220 536 451 509 537 694 1 080 548 991 2 748 609 489 2 099 626 612 2 477 630 776 1 456 635 303 3 974 649 578 3 826 666 736 2 572 670 637 2 205 673 724 782 681 1 120 2 848 695 1 559 2 649 696 773 2 064 740 859 1 752 744 710 2 967 754 671 2 625 756 629 1 256 756 530 2 442 798 1 651 1 684 804 625 5 446 834 778 2 193 837 853 2 102 845 730 2 346 864 1 068 2 096 871 558 3 126 874 687 3 193 877 778 2 225 919 668 1 685 938 1 274 4 693 952 976 821 965 1 715 4 653 1 032 798 1 292 1 069 1 507 5 160 1 100 1 038 3 104 1 133 1 270 5 057 1 201 988 5 644 1 223 886 5 695 1 249 1 122 4 586 1 279 869 3 819 1 313 1 690 3 556 1 353 1 201 4 398 1 370 1 260 5 799 1 380 1 166 4 735 1 393 1 336 3 372 1 500 813 4 880 1 508 1 522 6 216 1 578 1 199 8 041 1 609 1 416 6 884 1 617 1 909 8 556 1 779 1 522 3 858 1 900 2 359 9 309 2 001 1 689 7 639 2 191 1 594 5 039 2 192 2 008 6 321 2 198 1 262 5 363 2 283 1 890 6 642 2 554 2 599 5 338 3 028 3 107 5 865 3 446 4 404 5 395 3 754 4 436 11 218 4 293 4 275 10 796 4 656 4 944 9 594 5 145 5 441 22 162 6 225 8 019 17 773 6 618 6 634 15 153 7 590 7 508 20 202 7 663 6 509 17 094 9 945 11 166 28 435 10 277 7 551 41 169 14 738 13 704 44 525 15 100 15 136 45 104 18 103 14 819 31 118 22 259 19 638 72 772 26 073 22 274
Names of X columns:
weekdag zaterdag zondag

Sample Range: (leave blank to include all observations)
From:
To:

Column Number of Endogenous Series (?)


Fixed Seasonal Effects


Type of Equation


Degree of Predetermination (lagged endogenous variables)


Degree of Seasonal Predetermination


Seasonality


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') }

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
R Engine error message	Error in list(48, 3, 0, 38, 4, 0, 31, 4, 5, 31, 4, 4, 106, 5, 8, 81, 5, : argument 343 is empty Calls: array Execution halted