Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
12.9 0 21 21 26 50 13 12 13 13 149 18 68 7.4 0 23 26 51 68 NA NA NA NA 152 7 55 12.2 1 22 22 57 62 8 8 13 16 139 31 39 12.8 0 21 22 37 54 14 11 11 11 148 39 32 7.4 1 21 18 67 71 16 13 14 10 158 46 62 6.7 1 21 23 43 54 14 11 15 9 128 31 33 12.6 1 21 12 52 65 13 10 14 8 224 67 52 14.8 0 21 20 52 73 15 7 11 26 159 35 62 13.3 1 23 22 43 52 13 10 13 10 105 52 77 11.1 1 22 21 84 84 20 15 16 10 159 77 76 8.2 1 25 19 67 42 17 12 14 8 167 37 41 11.4 1 21 22 49 66 15 12 14 13 165 32 48 6.4 1 23 15 70 65 16 10 15 11 159 36 63 10.6 1 22 20 52 78 12 10 15 8 119 38 30 12.0 0 21 19 58 73 17 14 13 12 176 69 78 6.3 0 21 18 68 75 11 6 14 24 54 21 19 11.3 0 25 15 62 72 16 12 11 21 91 26 31 11.9 1 21 20 43 66 16 14 12 5 163 54 66 9.3 0 21 21 56 70 15 11 14 14 124 36 35 9.6 1 20 21 56 61 13 8 13 11 137 42 42 10.0 0 24 15 74 81 14 12 12 9 121 23 45 6.4 1 23 16 65 71 19 15 15 8 153 34 21 13.8 1 21 23 63 69 16 13 15 17 148 112 25 10.8 0 24 21 58 71 17 11 14 18 221 35 44 13.8 1 23 18 57 72 10 12 14 16 188 47 69 11.7 1 21 25 63 68 15 7 12 23 149 47 54 10.9 1 22 9 53 70 14 11 12 9 244 37 74 16.1 1 20 30 57 68 14 7 12 14 148 109 80 13.4 0 18 20 51 61 16 12 15 13 92 24 42 9.9 1 21 23 64 67 15 12 14 10 150 20 61 11.5 0 22 16 53 76 17 13 16 8 153 22 41 8.3 0 22 16 29 70 14 9 12 10 94 23 46 11.7 0 21 19 54 60 16 11 12 19 156 32 39 9.0 1 21 25 58 72 15 12 14 11 132 30 34 9.7 1 25 18 43 69 16 15 16 16 161 92 51 10.8 1 22 23 51 71 16 12 15 12 105 43 42 10.3 1 22 21 53 62 10 6 12 11 97 55 31 10.4 0 20 10 54 70 8 5 14 11 151 16 39 12.7 1 21 14 56 64 17 13 13 10 131 49 20 9.3 1 21 22 61 58 14 11 14 13 166 71 49 11.8 0 21 26 47 76 10 6 16 14 157 43 53 5.9 1 22 23 39 52 14 12 12 8 111 29 31 11.4 1 21 23 48 59 12 10 14 11 145 56 39 13.0 1 24 24 50 68 16 6 15 11 162 46 54 10.8 1 22 24 35 76 16 12 13 13 163 19 49 12.3 1 22 18 30 65 16 11 16 15 59 23 34 11.3 0 21 23 68 67 8 6 16 15 187 59 46 11.8 1 22 15 49 59 16 12 12 16 109 30 55 7.9 1 19 19 61 69 15 12 12 12 90 61 42 12.7 0 22 16 67 76 8 8 16 12 105 7 50 12.3 1 23 25 47 63 13 10 12 17 83 38 13 11.6 1 20 23 56 75 14 11 15 14 116 32 37 6.7 1 20 17 50 63 13 7 12 15 42 16 25 10.9 1 23 19 43 60 16 12 13 12 148 19 30 12.1 1 20 21 67 73 19 13 12 13 155 22 28 13.3 1 23 18 62 63 19 14 14 7 125 48 45 10.1 1 21 27 57 70 14 12 14 8 116 23 35 5.7 0 22 21 41 75 15 6 11 16 128 26 28 14.3 1 21 13 54 66 13 14 10 20 138 33 41 8.0 0 21 8 45 63 10 10 12 14 49 9 6 13.3 1 19 29 48 63 16 12 11 10 96 24 45 9.3 1 22 28 61 64 15 11 16 16 164 34 73 12.5 0 21 23 56 70 11 10 14 11 162 48 17 7.6 0 21 21 41 75 9 7 14 26 99 18 40 15.9 1 21 19 43 61 16 12 15 9 202 43 64 9.2 0 21 19 53 60 12 7 15 15 186 33 37 9.1 1 21 20 44 62 12 12 14 12 66 28 25 11.1 0 21 18 66 73 14 12 13 21 183 71 65 13.0 1 22 19 58 61 14 10 11 20 214 26 100 14.5 1 22 17 46 66 13 10 16 20 188 67 28 12.2 0 18 19 37 64 15 12 12 10 104 34 35 12.3 0 21 25 51 59 17 12 15 15 177 80 56 11.4 0 23 19 51 64 14 12 14 10 126 29 29 8.8 0 19 22 56 60 11 8 15 16 76 16 43 14.6 1 19 23 66 56 9 10 14 9 99 59 59 12.6 0 21 14 37 78 7 5 13 17 139 32 50 NA 1 21 28 59 53 13 10 6 10 78 47 3 13.0 0 21 16 42 67 15 10 12 19 162 43 59 12.6 1 21 24 38 59 12 12 12 13 108 38 27 13.2 0 20 20 66 66 15 11 14 8 159 29 61 9.9 0 19 12 34 68 14 9 14 11 74 36 28 7.7 1 21 24 53 71 16 12 15 9 110 32 51 10.5 0 19 22 49 66 14 11 11 12 96 35 35 13.4 0 19 12 55 73 13 10 13 10 116 21 29 10.9 0 19 22 49 72 16 12 14 9 87 29 48 4.3 1 20 20 59 71 13 10 16 14 97 12 25 10.3 0 19 10 40 59 16 9 13 14 127 37 44 11.8 1 19 23 58 64 16 11 14 10 106 37 64 11.2 1 19 17 60 66 16 12 16 8 80 47 32 11.4 0 20 22 63 78 10 7 11 13 74 51 20 8.6 0 19 24 56 68 12 11 13 9 91 32 28 13.2 0 18 18 54 73 12 12 13 14 133 21 34 12.6 1 19 21 52 62 12 6 15 8 74 13 31 5.6 1 21 20 34 65 12 9 12 16 114 14 26 9.9 1 18 20 69 68 19 15 13 14 140 -2 58 8.8 0 18 22 32 65 14 10 12 14 95 20 23 7.7 1 19 19 48 60 13 11 14 8 98 24 21 9.0 0 21 20 67 71 16 12 14 11 121 11 21 7.3 1 20 26 58 65 15 12 16 11 126 23 33 11.4 1 24 23 57 68 12 12 15 13 98 24 16 13.6 1 22 24 42 64 8 11 14 12 95 14 20 7.9 1 21 21 64 74 10 9 13 13 110 52 37 10.7 1 21 21 58 69 16 11 14 9 70 15 35 10.3 0 19 19 66 76 16 12 15 10 102 23 33 8.3 1 19 8 26 68 10 12 14 12 86 19 27 9.6 1 20 17 61 72 18 14 12 11 130 35 41 14.2 1 18 20 52 67 12 8 7 13 96 24 40 8.5 0 19 11 51 63 16 10 12 17 102 39 35 13.5 0 19 8 55 59 10 9 15 15 100 29 28 4.9 0 20 15 50 73 14 10 12 15 94 13 32 6.4 0 21 18 60 66 12 9 13 14 52 8 22 9.6 0 18 18 56 62 11 10 11 10 98 18 44 11.6 0 19 19 63 69 15 12 14 15 118 24 27 11.1 1 19 19 61 66 7 11 13 14 99 19 17
Names of X columns:
Score Geslacht Leeftijd Numeracy I,mot E,mot ConfStat ConfSoft STRESS depression LFM PRH CH
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
No 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, signif(mysum$coefficients[i,1],6), 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,signif(mysum$coefficients[i,1],6)) a<-table.element(a, signif(mysum$coefficients[i,2],6)) a<-table.element(a, signif(mysum$coefficients[i,3],4)) a<-table.element(a, signif(mysum$coefficients[i,4],6)) a<-table.element(a, signif(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, signif(sqrt(mysum$r.squared),6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a, signif(mysum$r.squared,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a, signif(mysum$adj.r.squared,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[1],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[2],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[3],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a, signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6)) 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, signif(mysum$sigma,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a, signif(sum(myerror*myerror),6)) 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,signif(x[i],6)) a<-table.element(a,signif(x[i]-mysum$resid[i],6)) a<-table.element(a,signif(mysum$resid[i],6)) 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,signif(gqarr[mypoint-kp3+1,1],6)) a<-table.element(a,signif(gqarr[mypoint-kp3+1,2],6)) a<-table.element(a,signif(gqarr[mypoint-kp3+1,3],6)) 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,signif(numsignificant1,6)) a<-table.element(a,signif(numsignificant1/numgqtests,6)) 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,signif(numsignificant5,6)) a<-table.element(a,signif(numsignificant5/numgqtests,6)) 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,signif(numsignificant10,6)) a<-table.element(a,signif(numsignificant10/numgqtests,6)) 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
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation