Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
01/2000 5 -1 6 24 9 02/2000 5 -4 6 29 11 03/2000 9 -6 8 29 13 04/2000 10 -9 4 25 12 05/2000 14 -13 8 16 13 06/2000 19 -13 10 18 15 07/2000 18 -10 9 13 13 08/2000 16 -12 12 22 16 09/2000 8 -9 9 15 10 10/2000 10 -15 11 20 14 11/2000 12 -14 11 19 14 12/2000 13 -18 11 18 15 01/2001 15 -13 11 13 13 02/2001 3 -2 11 17 8 03/2001 2 -1 9 17 7 04/2001 -2 5 8 13 3 05/2001 1 8 6 14 3 06/2001 1 6 7 13 4 07/2001 -1 7 8 17 4 08/2001 -6 15 6 17 0 09/2001 -13 23 5 15 -4 10/2001 -25 43 2 9 -14 11/2001 -26 60 3 10 -18 12/2001 -9 36 3 9 -8 01/2002 1 28 7 14 -1 02/2002 3 23 8 18 1 03/2002 6 23 7 18 2 04/2002 2 22 7 12 0 05/2002 5 22 6 16 1 06/2002 5 24 6 12 0 07/2002 0 32 7 19 -1 08/2002 -5 27 5 13 -3 09/2002 -4 27 5 12 -3 10/2002 -2 27 5 13 -3 11/2002 -1 29 4 11 -4 12/2002 -8 38 4 10 -8 01/2003 -16 40 4 16 -9 02/2003 -19 45 1 12 -13 03/2003 -28 50 -1 6 -18 04/2003 -11 43 3 8 -11 05/2003 -4 44 4 6 -9 06/2003 -9 44 3 8 -10 07/2003 -12 49 2 8 -13 08/2003 -10 42 1 9 -11 09/2003 -2 36 4 13 -5 10/2003 -13 57 3 8 -15 11/2003 0 42 5 11 -6 12/2003 0 39 6 8 -6 01/2004 4 33 6 10 -3 02/2004 7 32 6 15 -1 03/2004 5 34 6 12 -3 04/2004 2 37 6 13 -4 05/2004 -2 38 5 12 -6 06/2004 6 28 6 15 0 07/2004 -3 31 5 13 -4 08/2004 1 28 6 13 -2 09/2004 0 30 5 16 -2 10/2004 -7 39 7 14 -6 11/2004 -6 38 4 12 -7 12/2004 -4 39 5 15 -6 01/2005 -4 38 6 14 -6 02/2005 -2 37 6 19 -3 03/2005 2 32 5 16 -2 04/2005 -5 32 3 16 -5 05/2005 -15 44 2 11 -11 06/2005 -16 43 3 13 -11 07/2005 -18 42 3 12 -11 08/2005 -13 38 2 11 -10 09/2005 -23 37 0 6 -14 10/2005 -10 35 4 9 -8 11/2005 -10 37 4 6 -9 12/2005 -6 33 5 15 -5 01/2006 -3 24 6 17 -1 02/2006 -4 24 6 13 -2 03/2006 -7 31 5 12 -5 04/2006 -7 25 5 13 -4 05/2006 -7 28 3 10 -6 06/2006 -3 24 5 14 -2 07/2006 0 25 5 13 -2 08/2006 -5 16 5 10 -2 09/2006 -3 17 3 11 -2 10/2006 3 11 6 12 2 11/2006 2 12 6 7 1 12/2006 -7 39 4 11 -8 01/2007 -1 19 6 9 -1 02/2007 0 14 5 13 1 03/2007 -3 15 4 12 -1 04/2007 4 7 5 5 2 05/2007 2 12 5 13 2 06/2007 3 12 4 11 1 07/2007 0 14 3 8 -1 08/2007 -10 9 2 8 -2 09/2007 -10 8 3 8 -2 10/2007 -9 4 2 8 -1 11/2007 -22 7 -1 0 -8 12/2007 -16 3 0 3 -4 01/2008 -18 5 -2 0 -6 02/2008 -14 0 1 -1 -3 03/2008 -12 -2 -2 -1 -3 04/2008 -17 6 -2 -4 -7 05/2008 -23 11 -2 1 -9 06/2008 -28 9 -6 -1 -11 07/2008 -31 17 -4 0 -13 08/2008 -21 21 -2 -1 -11 09/2008 -19 21 0 6 -9 10/2008 -22 41 -5 0 -17 11/2008 -22 57 -4 -3 -22 12/2008 -25 65 -5 -3 -25 01/2009 -16 68 -1 4 -20 02/2009 -22 73 -2 1 -24 03/2009 -21 71 -4 0 -24 04/2009 -10 71 -1 -4 -22 05/2009 -7 70 1 -2 -19 06/2009 -5 69 1 3 -18 07/2009 -4 65 -2 2 -17 08/2009 7 57 1 5 -11 09/2009 6 57 1 6 -11 10/2009 3 57 3 6 -12 11/2009 10 55 3 3 -10 12/2009 0 65 1 4 -15 01/2010 -2 65 1 7 -15 02/2010 -1 64 0 5 -15 03/2010 2 60 2 6 -13 04/2010 8 43 2 1 -8 05/2010 -6 47 -1 3 -13 06/2010 -4 40 1 6 -9 07/2010 4 31 0 0 -7 08/2010 7 27 1 3 -4 09/2010 3 24 1 4 -4 10/2010 3 23 3 7 -2 11/2010 8 17 2 6 0 12/2010 3 16 0 6 -2 01/2011 -3 15 0 6 -3 02/2011 4 8 3 6 1 03/2011 -5 5 -2 2 -2 04/2011 -1 6 0 2 -1 05/2011 5 5 1 2 1 06/2011 0 12 -1 3 -3 07/2011 -6 8 -2 -1 -4 08/2011 -13 17 -1 -4 -9 09/2011 -15 22 -1 4 -9 10/2011 -8 24 1 5 -7 11/2011 -20 36 -2 3 -14 12/2011 -10 31 -5 -1 -12 01/2012 -22 34 -5 -4 -16 02/2012 -25 47 -6 0 -20 03/2012 -10 33 -4 -1 -12 04/2012 -8 35 -3 -1 -12 05/2012 -9 31 -3 3 -10 06/2012 -5 35 -1 2 -10 07/2012 -7 39 -2 -4 -13 08/2012 -11 46 -3 -3 -16 09/2012 -11 40 -3 -1 -14 10/2012 -16 50 -3 3 -17
Names of X columns:
Date Vooruitzichten_economische_situatie Vooruitzichten_werkloosheid Vooruitzichten_financiele_situatie Vooruitzichten_spaarvermogen Indicator_consumentenvertrouwen
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
5
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
0
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