Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
2000 41 38 13 12 14 12 53 32 2000 39 32 16 11 18 11 86 51 2000 30 35 19 15 11 14 66 42 2000 31 33 15 6 12 12 67 41 2000 34 37 14 13 16 21 76 46 2000 35 29 13 10 18 12 78 47 2000 39 31 19 12 14 22 53 37 2000 34 36 15 14 14 11 80 49 2000 36 35 14 12 15 10 74 45 2000 37 38 15 6 15 13 76 47 2000 38 31 16 10 17 10 79 49 2000 36 34 16 12 19 8 54 33 2000 38 35 16 12 10 15 67 42 2001 39 38 16 11 16 14 54 33 2001 33 37 17 15 18 10 87 53 2001 32 33 15 12 14 14 58 36 2001 36 32 15 10 14 14 75 45 2001 38 38 20 12 17 11 88 54 2001 39 38 18 11 14 10 64 41 2001 32 32 16 12 16 13 57 36 2001 32 33 16 11 18 7 66 41 2001 31 31 16 12 11 14 68 44 2001 39 38 19 13 14 12 54 33 2001 37 39 16 11 12 14 56 37 2001 39 32 17 9 17 11 86 52 2001 41 32 17 13 9 9 80 47 2002 36 35 16 10 16 11 76 43 2002 33 37 15 14 14 15 69 44 2002 33 33 16 12 15 14 78 45 2002 34 33 14 10 11 13 67 44 2002 31 28 15 12 16 9 80 49 2002 27 32 12 8 13 15 54 33 2002 37 31 14 10 17 10 71 43 2002 34 37 16 12 15 11 84 54 2002 34 30 14 12 14 13 74 42 2002 32 33 7 7 16 8 71 44 2002 29 31 10 6 9 20 63 37 2002 36 33 14 12 15 12 71 43 2002 29 31 16 10 17 10 76 46 2003 35 33 16 10 13 10 69 42 2003 37 32 16 10 15 9 74 45 2003 34 33 14 12 16 14 75 44 2003 38 32 20 15 16 8 54 33 2003 35 33 14 10 12 14 52 31 2003 38 28 14 10 12 11 69 42 2003 37 35 11 12 11 13 68 40 2003 38 39 14 13 15 9 65 43 2003 33 34 15 11 15 11 75 46 2003 36 38 16 11 17 15 74 42 2003 38 32 14 12 13 11 75 45 2003 32 38 16 14 16 10 72 44 2003 32 30 14 10 14 14 67 40 2004 32 33 12 12 11 18 63 37 2004 34 38 16 13 12 14 62 46 2004 32 32 9 5 12 11 63 36 2004 37 32 14 6 15 12 76 47 2004 39 34 16 12 16 13 74 45 2004 29 34 16 12 15 9 67 42 2004 37 36 15 11 12 10 73 43 2004 35 34 16 10 12 15 70 43 2004 30 28 12 7 8 20 53 32 2004 38 34 16 12 13 12 77 45 2004 34 35 16 14 11 12 77 45 2004 31 35 14 11 14 14 52 31 2004 34 31 16 12 15 13 54 33 2004 35 37 17 13 10 11 80 49 2005 36 35 18 14 11 17 66 42 2005 30 27 18 11 12 12 73 41 2005 39 40 12 12 15 13 63 38 2005 35 37 16 12 15 14 69 42 2005 38 36 10 8 14 13 67 44 2005 31 38 14 11 16 15 54 33 2005 34 39 18 14 15 13 81 48 2005 38 41 18 14 15 10 69 40 2005 34 27 16 12 13 11 84 50 2005 39 30 17 9 12 19 80 49 2005 37 37 16 13 17 13 70 43 2005 34 31 16 11 13 17 69 44 2005 28 31 13 12 15 13 77 47 2005 37 27 16 12 13 9 54 33 2006 33 36 16 12 15 11 79 46 2006 37 38 20 12 16 10 30 0 2006 35 37 16 12 15 9 71 45 2006 37 33 15 12 16 12 73 43 2006 32 34 15 11 15 12 72 44 2006 33 31 16 10 14 13 77 47 2006 38 39 14 9 15 13 75 45 2006 33 34 16 12 14 12 69 42 2006 29 32 16 12 13 15 54 33 2006 33 33 15 12 7 22 70 43 2006 31 36 12 9 17 13 73 46 2006 36 32 17 15 13 15 54 33 2006 35 41 16 12 15 13 77 46 2006 32 28 15 12 14 15 82 48 2007 29 30 13 12 13 10 80 47 2007 39 36 16 10 16 11 80 47 2007 37 35 16 13 12 16 69 43 2007 35 31 16 9 14 11 78 46 2007 37 34 16 12 17 11 81 48 2007 32 36 14 10 15 10 76 46 2007 38 36 16 14 17 10 76 45 2007 37 35 16 11 12 16 73 45 2007 36 37 20 15 16 12 85 52 2007 32 28 15 11 11 11 66 42 2007 33 39 16 11 15 16 79 47 2007 40 32 13 12 9 19 68 41 2007 38 35 17 12 16 11 76 47 2007 41 39 16 12 15 16 71 43 2008 36 35 16 11 10 15 54 33 2008 43 42 12 7 10 24 46 30 2008 30 34 16 12 15 14 82 49 2008 31 33 16 14 11 15 74 44 2008 32 41 17 11 13 11 88 55 2008 32 33 13 11 14 15 38 11 2008 37 34 12 10 18 12 76 47 2008 37 32 18 13 16 10 86 53 2008 33 40 14 13 14 14 54 33 2008 34 40 14 8 14 13 70 44 2008 33 35 13 11 14 9 69 42 2008 38 36 16 12 14 15 90 55 2008 33 37 13 11 12 15 54 33 2008 31 27 16 13 14 14 76 46 2009 38 39 13 12 15 11 89 54 2009 37 38 16 14 15 8 76 47 2009 33 31 15 13 15 11 73 45 2009 31 33 16 15 13 11 79 47 2009 39 32 15 10 17 8 90 55 2009 44 39 17 11 17 10 74 44 2009 33 36 15 9 19 11 81 53 2009 35 33 12 11 15 13 72 44 2009 32 33 16 10 13 11 71 42 2009 28 32 10 11 9 20 66 40 2009 40 37 16 8 15 10 77 46 2009 27 30 12 11 15 15 65 40 2009 37 38 14 12 15 12 74 46 2009 32 29 15 12 16 14 82 53 2010 28 22 13 9 11 23 54 33 2010 34 35 15 11 14 14 63 42 2010 30 35 11 10 11 16 54 35 2010 35 34 12 8 15 11 64 40 2010 31 35 8 9 13 12 69 41 2010 32 34 16 8 15 10 54 33 2010 30 34 15 9 16 14 84 51 2010 30 35 17 15 14 12 86 53 2010 31 23 16 11 15 12 77 46 2010 40 31 10 8 16 11 89 55 2010 32 27 18 13 16 12 76 47 2010 36 36 13 12 11 13 60 38 2010 32 31 16 12 12 11 75 46 2010 35 32 13 9 9 19 73 46 2011 38 39 10 7 16 12 85 53 2011 42 37 15 13 13 17 79 47 2011 34 38 16 9 16 9 71 41 2011 35 39 16 6 12 12 72 44 2011 35 34 14 8 9 19 69 43 2011 33 31 10 8 13 18 78 51 2011 36 32 17 15 13 15 54 33 2011 32 37 13 6 14 14 69 43 2011 33 36 15 9 19 11 81 53 2011 34 32 16 11 13 9 84 51 2011 32 35 12 8 12 18 84 50 2011 34 36 13 8 13 16 69 46
Names of X columns:
jaar 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