Wessa.net

Send output to:

Data X:
1 501 134 368 6.70 8.50 8.70 2 485 124 361 6.80 8.40 8.60 3 464 113 351 6.70 8.40 8.60 4 460 109 351 6.60 8.30 8.50 5 467 109 358 6.40 8.20 8.50 6 460 106 354 6.30 8.20 8.50 7 448 101 347 6.30 8.10 8.50 8 443 98 345 6.50 8.10 8.50 9 436 93 343 6.50 8.10 8.50 10 431 91 340 6.40 8.10 8.50 11 484 122 362 6.20 8.10 8.50 12 510 139 370 6.20 8.10 8.60 13 513 140 373 6.50 8.10 8.60 14 503 132 371 7.00 8.20 8.60 15 471 117 354 7.20 8.20 8.70 16 471 114 357 7.30 8.30 8.70 17 476 113 363 7.40 8.20 8.70 18 475 110 364 7.40 8.30 8.80 19 470 107 363 7.40 8.30 8.80 20 461 103 358 7.30 8.40 8.90 21 455 98 357 7.40 8.50 8.90 22 456 98 357 7.40 8.50 8.90 23 517 137 380 7.60 8.60 9.00 24 525 148 378 7.60 8.60 9.00 25 523 147 376 7.70 8.70 9.00 26 519 139 380 7.70 8.70 9.00 27 509 130 379 7.80 8.80 9.00 28 512 128 384 7.80 8.80 9.00 29 519 127 392 8.00 8.90 9.10 30 517 123 394 8.10 9.00 9.10 31 510 118 392 8.10 9.00 9.10 32 509 114 396 8.20 9.00 9.10 33 501 108 392 8.10 9.00 9.10 34 507 111 396 8.10 9.10 9.10 35 569 151 419 8.10 9.10 9.10 36 580 159 421 8.10 9.00 9.10 37 578 158 420 8.20 9.10 9.10 38 565 148 418 8.20 9.00 9.10 39 547 138 410 8.30 9.10 9.10 40 555 137 418 8.40 9.10 9.20 41 562 136 426 8.60 9.20 9.30 42 561 133 428 8.60 9.20 9.30 43 555 126 430 8.40 9.20 9.30 44 544 120 424 8.00 9.20 9.20 45 537 114 423 7.90 9.20 9.20 46 543 116 427 8.10 9.30 9.20 47 594 153 441 8.50 9.30 9.20 48 611 162 449 8.80 9.30 9.20 49 613 161 452 8.80 9.30 9.20 50 611 149 462 8.50 9.30 9.20 51 594 139 455 8.30 9.40 9.20 52 595 135 461 8.30 9.40 9.20 53 591 130 461 8.30 9.30 9.20 54 589 127 463 8.40 9.30 9.20 55 584 122 462 8.50 9.30 9.20 56 573 117 456 8.50 9.30 9.20 57 567 112 455 8.60 9.20 9.10 58 569 113 456 8.50 9.20 9.10 59 621 149 472 8.60 9.20 9.00 60 629 157 472 8.60 9.10 8.90 61 628 157 471 8.60 9.10 8.90 62 612 147 465 8.50 9.10 9.00 63 595 137 459 8.40 9.10 8.90 64 597 132 465 8.40 9.00 8.80 65 593 125 468 8.50 8.90 8.70 66 590 123 467 8.50 8.80 8.60 67 580 117 463 8.50 8.70 8.50 68 574 114 460 8.60 8.60 8.50 69 573 111 462 8.60 8.60 8.40 70 573 112 461 8.40 8.50 8.30 71 620 144 476 8.20 8.40 8.20 72 626 150 476 8.00 8.40 8.20 73 620 149 471 8.00 8.30 8.10 74 588 134 453 8.00 8.20 8.00 75 566 123 443 8.00 8.20 7.90 76 557 116 442 7.90 8.00 7.80 77 561 117 444 7.90 7.90 7.60 78 549 111 438 7.90 7.80 7.50 79 532 105 427 7.90 7.70 7.40 80 526 102 424 8.00 7.60 7.30 81 511 95 416 7.90 7.60 7.30 82 499 93 406 7.40 7.60 7.20 83 555 124 431 7.20 7.60 7.20 84 565 130 434 7.00 7.60 7.20 85 542 124 418 6.90 7.50 7.10 86 527 115 412 7.10 7.50 7.00 87 510 106 404 7.20 7.40 7.00 88 514 105 409 7.20 7.40 6.90 89 517 105 412 7.10 7.40 6.90 90 508 101 406 6.90 7.30 6.80 91 493 95 398 6.80 7.30 6.80 92 490 93 397 6.80 7.40 6.80 93 469 84 385 6.80 7.50 6.90 94 478 87 390 6.90 7.60 7.00 95 528 116 413 7.10 7.60 7.00 96 534 120 413 7.20 7.70 7.10 97 518 117 401 7.20 7.70 7.20 98 506 109 397 7.10 7.90 7.30 99 502 105 397 7.10 8.10 7.50 100 516 107 409 7.20 8.40 7.70 101 528 109 419 7.50 8.70 8.10 102 533 109 424 7.70 9.00 8.40 103 536 108 428 7.80 9.30 8.60 104 537 107 430 7.70 9.40 8.80 105 524 99 424 7.70 9.50 8.90 106 536 103 433 7.80 9.60 9.10 107 587 131 456 8.00 9.80 9.20 108 597 137 459 8.10 9.80 9.30 109 581 135 446 8.10 9.90 9.40 110 564 124 441 8.00 10.00 9.40 111 558 118 439 8.10 10.00 9.50 112 575 121 454 8.20 10.10 9.50 113 580 121 460 8.40 10.10 9.70 114 575 118 457 8.50 10.10 9.70 115 563 113 451 8.50 10.10 9.70 116 552 107 444 8.50 10.20 9.70 117 537 100 437 8.50 10.20 9.70 118 545 102 443 8.50 10.10 9.60 119 601 130 471 8.40 10.10 9.60 120 604 136 469 8.30 10.10 9.60 121 586 133 454 8.20 10.10 9.60 122 564 120 444 8.10 10.10 9.60 123 549 112 436 7.90 10.10 9.60 124 551 109 442 7.60 10.10 9.60 125 556 110 446 7.30 10.00 9.50 126 548 106 442 7.10 9.90 9.50 127 540 102 438 7.00 9.90 9.40 128 531 98 433 7.10 9.90 9.40 129 521 92 428 7.10 9.90 9.50 130 519 92 426 7.10 10.00 9.50 131 572 120 452 7.30 10.10 9.60 132 581 127 455 7.30 10.20 9.70 133 563 124 439 7.30 10.30 9.80 134 548 114 434 7.20 10.50 9.90 135 539 108 431 7.20 10.60 10.00 136 541 106 435 7.10 10.70 10.00 137 562 111 450 7.10 10.80 10.10 138 559 110 449 7.10 10.90 10.20 139 546 104 442 7.20 11.00 10.30 140 536 100 437 7.30 11.20 10.30 141 528 96 431 7.40 11.30 10.40 142 530 98 433 7.40 11.40 10.50 143 582 122 460 7.50 11.50 10.50 144 599 134 465 7.40 11.50 10.60 145 584 133 451 7.40 11.60 10.60
Names of X columns:
t Totale_werkloosheid Jonger_dan_25 Vanaf_25 België Euroraad EU-27

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