Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
349 0 0 336 349 0 331 336 349 327 331 336 323 327 331 322 323 327 385 322 323 405 385 322 412 405 385 411 412 405 410 411 412 415 410 411 414 415 410 411 414 415 408 411 414 410 408 411 411 410 408 416 411 410 479 416 411 498 479 416 502 498 479 498 502 498 499 498 502 506 499 498 510 506 499 509 510 506 502 509 510 495 502 509 490 495 502 490 490 495 553 490 490 570 553 490 573 570 553 572 573 570 575 572 573 580 575 572 580 580 575 574 580 580 563 574 580 556 563 574 546 556 563 545 546 556 605 545 546 628 605 545 631 628 605 626 631 628 614 626 631 606 614 626 602 606 614 589 602 606 574 589 602 558 574 589 552 558 574 546 552 558 607 546 552 636 607 546 631 636 607 623 631 636 618 623 631 605 618 623 619 605 618 596 619 605 570 596 619 546 570 596 528 546 570 506 528 546 555 506 528 568 555 506 564 568 555 553 564 568 541 553 564 542 541 553 540 542 541 521 540 542 505 521 540 491 505 521 482 491 505 478 482 491 523 478 482 531 523 478 532 531 523 540 532 531 525 540 532 533 525 540 531 533 525 508 531 533 495 508 531 482 495 508 470 482 495 466 470 482 515 466 470 518 515 466 516 518 515 511 516 518 500 511 516 498 500 511 494 498 500 476 494 498 458 476 494 443 458 476 430 443 458 424 430 443 476 424 430 481 476 424 470 481 476 460 470 481 451 460 470 450 451 460 444 450 451 429 444 450 421 429 444 400 421 429 389 400 421 384 389 400 432 384 389 446 432 384 431 446 432 423 431 446 416 423 431 416 416 423 413 416 416 399 413 416 386 399 413 374 386 399 365 374 386 365 365 374 418 365 365 428 418 365 424 428 418 421 424 428 417 421 424 423 417 421 423 423 417 419 423 423 406 419 423 398 406 419 390 398 406 391 390 398 444 391 390 460 444 391 455 460 444 456 455 460 452 456 455 459 452 456 461 459 452 451 461 459 443 451 461 439 443 451 430 439 443 436 430 439 488 436 430 506 488 436 502 506 488 501 502 506 501 501 502 515 501 501 521 515 501 520 521 515 512 520 521 509 512 520 505 509 512 511 505 509 570 511 505 592 570 511 594 592 570 586 594 592 586 586 594 592 586 586 594 592 586 594 594 592 586 594 594 586 586 594 572 586 586 572 572 586 563 572 572 563 563 572 555 563 563 555 555 563 554 555 555 554 554 555 601 554 554 601 601 554 622 601 601 622 622 601 617 622 622 617 617 622 606 617 617 606 606 617 595 606 606 595 595 606 599 595 595 599 599 595 600 599 599 600 600 599 592 600 600 592 592 600 575 592 592 575 575 592 567 575 575 567 567 575 555 567 567 555 555 567 555 555 555 555 555 555 608 555 555 608 608 555 631 608 608 631 631 608 629 631 631 629 629 631 624 629 629 624 624 629 610 624 624 610 610 624 616 610 610 616 616 610 621 616 616 621 621 616 604 621 621 604 604 621 584 604 604 584 584 604 574 584 584 574 574 584 555 574 574 555 555 574 545 555 555 545 545 555 599 545 545 599 599 545 620 599 599 620 620 599 608 620 620 608 608 620 590 608 608 590 590 608 579 590 590 579 579 590 580 579 579 580 580 579 579 580 580 579 579 580 572 579 579 572 572 579 560 572 572 560 560 572 551 560 560 551 551 560 537 551 551 537 537 551 541 537 537 541 541 537 588 541 541 588 588 541 607 588 588 607 607 588 599 607 607 599 599 607 578 599 599 578 578 599 563 578 578 563 563 578 566 563 563 566 566 563 561 566 566 561 561 566 554 561 561 554 554 561 540 554 554 540 540 554 526 540 540 526 526 540 512 526 526 512 512 526 505 512 512 505 505 512 554 505 505 554 554 505 584 554 554 584 584 554 569 584 584 569 569 584 540 569 569 540 540 569 522 540 540 522 522 540 526 522 522 526 526 522 527 526 526 527 527 526 516 527 527 516 516 527 503 516 516 503 503 516 489 503 503 489 489 503 479 489 489 479 479 489 475 479 479 475 475 479 524 475 475 524 524 475 552 524 524 552 552 524 532 552 552 532 532 552 511 532 532 511 511 532 492 511 511 492 492 511 492 492 492 492 492 492 493 492 492 493 493 492 481 493 493 481 481 493 462 481 481 462 462 481 457 462 462 457 457 462 442 457 457 442 442 457 439 442 442 439 439 442 488 439 439 488 488 439 521 488 488 521 521 488 501 521 521 501 501 521 485 501 501 485 485 501 464 485 485 464 464 485 460 464 464 460 460 464 467 460 460 467 467 460 460 467 467 460 460 467 448 460 460 448 448 460 443 448 448 443 443 448 436 443 443 436 436 443 431 436 436 431 431 436 484 431 431 484 484 431 510 484 484 510 510 484 513 510 510 513 513 510 503 513 513 503 503 513 471 503 503 471 471 503 471 471 471 471 471 471 476 471 471 476 476 471 475 476 476 475 475 476 470 475 475 470 470 475 461 470 470 461 461 470 455 461 461 455 455 461 456 455 455 456 456 455 517 456 456 517 517 456 525 517 517 525 525 517 523 525 525 523 523 525 519 523 523 519 519 523 509 519 519 509 509 519 512 509 509 512 512 509 519 512 512 519 519 512 517 519 519 517 517 519 510 517 517 510 510 517 509 510 510 509 509 510 501 509 509 501 501 509 507 501 501 507 507 501 569 507 507 569 569 507 580 569 569 580 580 569 578 580 580 578 578 580 565 578 578 565 565 578 547 565 565 547 547 565 555 547 547 555 555 547 562 555 555 561 562 555 555 561 562 544 555 561 537 544 555 543 537 544 594 543 537 611 594 543 613 611 594 611 613 611 594 611 613 595 594 611 591 595 594 589 591 595 584 589 591 573 584 589 567 573 584 569 567 573 621 569 567 629 621 569 628 629 621 612 628 629 595 612 628 597 595 612 593 597 595 590 593 597 580 590 593 574 580 590 573 574 580 573 573 574 620 573 573 626 620 573 620 626 620 588 620 626 566 588 620 557 566 588 561 557 566 549 561 557 532 549 561 526 532 549 511 526 532 499 511 526 555 499 511 565 555 499 542 565 555 527 542 565 510 527 542 514 510 527 517 514 510 508 517 514 493 508 517 490 493 508 469 490 493 478 469 490 528 478 469 534 528 478 518 534 528 506 518 534 502 506 518 516 502 506 528 516 502 533 528 516 536 533 528 537 536 533 524 537 536 536 524 537 587 536 524 597 587 536 581 597 587 564 581 597 558 564 581 575 558 564 580 575 558 575 580 575 563 575 580 552 563 575 537 552 563 545 537 552 601 545 537 604 601 545 586 604 601 564 586 604 549 564 586 551 549 564
Names of X columns:
werkloosheid y1 y2
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