Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
2000 1 41 38 13 12 14 12 53 32 2000 2 39 32 16 11 18 11 86 51 2000 3 30 35 19 15 11 14 66 42 2000 4 31 33 15 6 12 12 67 41 2000 5 34 37 14 13 16 21 76 46 2000 6 35 29 13 10 18 12 78 47 2000 7 39 31 19 12 14 22 53 37 2000 8 34 36 15 14 14 11 80 49 2000 9 36 35 14 12 15 10 74 45 2000 10 37 38 15 6 15 13 76 47 2000 11 38 31 16 10 17 10 79 49 2000 12 36 34 16 12 19 8 54 33 2000 13 38 35 16 12 10 15 67 42 2001 14 39 38 16 11 16 14 54 33 2001 15 33 37 17 15 18 10 87 53 2001 16 32 33 15 12 14 14 58 36 2001 17 36 32 15 10 14 14 75 45 2001 18 38 38 20 12 17 11 88 54 2001 19 39 38 18 11 14 10 64 41 2001 20 32 32 16 12 16 13 57 36 2001 21 32 33 16 11 18 7 66 41 2001 22 31 31 16 12 11 14 68 44 2001 23 39 38 19 13 14 12 54 33 2001 24 37 39 16 11 12 14 56 37 2001 25 39 32 17 9 17 11 86 52 2001 26 41 32 17 13 9 9 80 47 2002 27 36 35 16 10 16 11 76 43 2002 28 33 37 15 14 14 15 69 44 2002 29 33 33 16 12 15 14 78 45 2002 30 34 33 14 10 11 13 67 44 2002 31 31 28 15 12 16 9 80 49 2002 32 27 32 12 8 13 15 54 33 2002 33 37 31 14 10 17 10 71 43 2002 34 34 37 16 12 15 11 84 54 2002 35 34 30 14 12 14 13 74 42 2002 36 32 33 7 7 16 8 71 44 2002 37 29 31 10 6 9 20 63 37 2002 38 36 33 14 12 15 12 71 43 2002 39 29 31 16 10 17 10 76 46 2003 40 35 33 16 10 13 10 69 42 2003 41 37 32 16 10 15 9 74 45 2003 42 34 33 14 12 16 14 75 44 2003 43 38 32 20 15 16 8 54 33 2003 44 35 33 14 10 12 14 52 31 2003 45 38 28 14 10 12 11 69 42 2003 46 37 35 11 12 11 13 68 40 2003 47 38 39 14 13 15 9 65 43 2003 48 33 34 15 11 15 11 75 46 2003 49 36 38 16 11 17 15 74 42 2003 50 38 32 14 12 13 11 75 45 2003 51 32 38 16 14 16 10 72 44 2003 52 32 30 14 10 14 14 67 40 2004 53 32 33 12 12 11 18 63 37 2004 54 34 38 16 13 12 14 62 46 2004 55 32 32 9 5 12 11 63 36 2004 56 37 32 14 6 15 12 76 47 2004 57 39 34 16 12 16 13 74 45 2004 58 29 34 16 12 15 9 67 42 2004 59 37 36 15 11 12 10 73 43 2004 60 35 34 16 10 12 15 70 43 2004 61 30 28 12 7 8 20 53 32 2004 62 38 34 16 12 13 12 77 45 2004 63 34 35 16 14 11 12 77 45 2004 64 31 35 14 11 14 14 52 31 2004 65 34 31 16 12 15 13 54 33 2004 66 35 37 17 13 10 11 80 49 2005 67 36 35 18 14 11 17 66 42 2005 68 30 27 18 11 12 12 73 41 2005 69 39 40 12 12 15 13 63 38 2005 70 35 37 16 12 15 14 69 42 2005 71 38 36 10 8 14 13 67 44 2005 72 31 38 14 11 16 15 54 33 2005 73 34 39 18 14 15 13 81 48 2005 74 38 41 18 14 15 10 69 40 2005 75 34 27 16 12 13 11 84 50 2005 76 39 30 17 9 12 19 80 49 2005 77 37 37 16 13 17 13 70 43 2005 78 34 31 16 11 13 17 69 44 2005 79 28 31 13 12 15 13 77 47 2005 80 37 27 16 12 13 9 54 33 2006 81 33 36 16 12 15 11 79 46 2006 82 37 38 20 12 16 10 30 0 2006 83 35 37 16 12 15 9 71 45 2006 84 37 33 15 12 16 12 73 43 2006 85 32 34 15 11 15 12 72 44 2006 86 33 31 16 10 14 13 77 47 2006 87 38 39 14 9 15 13 75 45 2006 88 33 34 16 12 14 12 69 42 2006 89 29 32 16 12 13 15 54 33 2006 90 33 33 15 12 7 22 70 43 2006 91 31 36 12 9 17 13 73 46 2006 92 36 32 17 15 13 15 54 33 2006 93 35 41 16 12 15 13 77 46 2006 94 32 28 15 12 14 15 82 48 2007 95 29 30 13 12 13 10 80 47 2007 96 39 36 16 10 16 11 80 47 2007 97 37 35 16 13 12 16 69 43 2007 98 35 31 16 9 14 11 78 46 2007 99 37 34 16 12 17 11 81 48 2007 100 32 36 14 10 15 10 76 46 2007 101 38 36 16 14 17 10 76 45 2007 102 37 35 16 11 12 16 73 45 2007 103 36 37 20 15 16 12 85 52 2007 104 32 28 15 11 11 11 66 42 2007 105 33 39 16 11 15 16 79 47 2007 106 40 32 13 12 9 19 68 41 2007 107 38 35 17 12 16 11 76 47 2007 108 41 39 16 12 15 16 71 43 2008 109 36 35 16 11 10 15 54 33 2008 110 43 42 12 7 10 24 46 30 2008 111 30 34 16 12 15 14 82 49 2008 112 31 33 16 14 11 15 74 44 2008 113 32 41 17 11 13 11 88 55 2008 114 32 33 13 11 14 15 38 11 2008 115 37 34 12 10 18 12 76 47 2008 116 37 32 18 13 16 10 86 53 2008 117 33 40 14 13 14 14 54 33 2008 118 34 40 14 8 14 13 70 44 2008 119 33 35 13 11 14 9 69 42 2008 120 38 36 16 12 14 15 90 55 2008 121 33 37 13 11 12 15 54 33 2008 122 31 27 16 13 14 14 76 46 2009 123 38 39 13 12 15 11 89 54 2009 124 37 38 16 14 15 8 76 47 2009 125 33 31 15 13 15 11 73 45 2009 126 31 33 16 15 13 11 79 47 2009 127 39 32 15 10 17 8 90 55 2009 128 44 39 17 11 17 10 74 44 2009 129 33 36 15 9 19 11 81 53 2009 130 35 33 12 11 15 13 72 44 2009 131 32 33 16 10 13 11 71 42 2009 132 28 32 10 11 9 20 66 40 2009 133 40 37 16 8 15 10 77 46 2009 134 27 30 12 11 15 15 65 40 2009 135 37 38 14 12 15 12 74 46 2009 136 32 29 15 12 16 14 82 53 2010 137 28 22 13 9 11 23 54 33 2010 138 34 35 15 11 14 14 63 42 2010 139 30 35 11 10 11 16 54 35 2010 140 35 34 12 8 15 11 64 40 2010 141 31 35 8 9 13 12 69 41 2010 142 32 34 16 8 15 10 54 33 2010 143 30 34 15 9 16 14 84 51 2010 144 30 35 17 15 14 12 86 53 2010 145 31 23 16 11 15 12 77 46 2010 146 40 31 10 8 16 11 89 55 2010 147 32 27 18 13 16 12 76 47 2010 148 36 36 13 12 11 13 60 38 2010 149 32 31 16 12 12 11 75 46 2010 150 35 32 13 9 9 19 73 46 2011 151 38 39 10 7 16 12 85 53 2011 152 42 37 15 13 13 17 79 47 2011 153 34 38 16 9 16 9 71 41 2011 154 35 39 16 6 12 12 72 44 2011 155 35 34 14 8 9 19 69 43 2011 156 33 31 10 8 13 18 78 51 2011 157 36 32 17 15 13 15 54 33 2011 158 32 37 13 6 14 14 69 43 2011 159 33 36 15 9 19 11 81 53 2011 160 34 32 16 11 13 9 84 51 2011 161 32 35 12 8 12 18 84 50 2011 162 34 36 13 8 13 16 69 46
Names of X columns:
jaar volgnummer Connected Separate Learning Software Happiness Depression Belonging Belonging_Final
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
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