Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
4.35 0 1 22 23 48 23 12 41 12.7 0 1 22 22 50 16 45 146 18.1 0 1 22 21 150 33 37 182 17.85 0 1 20 25 154 32 37 192 16.6 1 0 19 30 109 37 108 263 12.6 1 1 20 17 68 14 10 35 17.1 0 1 22 27 194 52 68 439 19.1 0 0 21 23 158 75 72 214 16.1 0 1 21 23 159 72 143 341 13.35 0 0 21 18 67 15 9 58 18.4 0 0 21 18 147 29 55 292 14.7 0 1 21 23 39 13 17 85 10.6 0 1 21 19 100 40 37 200 12.6 0 1 21 15 111 19 27 158 16.2 0 1 22 20 138 24 37 199 13.6 0 1 24 16 101 121 58 297 18.9 1 1 21 24 131 93 66 227 14.1 0 1 22 25 101 36 21 108 14.5 0 1 20 25 114 23 19 86 16.15 0 0 21 19 165 85 78 302 14.75 0 1 24 19 114 41 35 148 14.8 0 1 25 16 111 46 48 178 12.45 0 1 22 19 75 18 27 120 12.65 0 1 21 19 82 35 43 207 17.35 0 1 21 23 121 17 30 157 8.6 0 1 22 21 32 4 25 128 18.4 0 0 23 22 150 28 69 296 16.1 0 1 24 19 117 44 72 323 11.6 1 1 20 20 71 10 23 79 17.75 0 1 22 20 165 38 13 70 15.25 0 1 25 3 154 57 61 146 17.65 0 1 22 23 126 23 43 246 15.6 0 0 22 14 138 26 22 145 16.35 0 0 21 23 149 36 51 196 17.65 0 0 21 20 145 22 67 199 13.6 0 1 21 15 120 40 36 127 11.7 0 0 22 13 138 18 21 91 14.35 0 0 22 16 109 31 44 153 14.75 0 0 22 7 132 11 45 299 18.25 0 1 21 24 172 38 34 228 9.9 0 0 22 17 169 24 36 190 16 0 1 23 24 114 37 72 180 18.25 0 1 21 24 156 37 39 212 16.85 0 0 21 19 172 22 43 269 14.6 1 1 21 25 68 15 25 130 13.85 1 1 19 20 89 2 56 179 18.95 0 1 21 28 167 43 80 243 15.6 0 0 21 23 113 31 40 190 14.85 1 0 19 27 115 29 73 299 11.75 1 0 18 18 78 45 34 121 18.45 1 0 19 28 118 25 72 137 15.9 1 1 21 21 87 4 42 305 17.1 0 0 22 19 173 31 61 157 16.1 0 1 22 23 2 -4 23 96 19.9 1 0 19 27 162 66 74 183 10.95 1 1 20 22 49 61 16 52 18.45 1 0 19 28 122 32 66 238 15.1 1 1 21 25 96 31 9 40 15 1 0 19 21 100 39 41 226 11.35 1 0 20 22 82 19 57 190 15.95 1 1 21 28 100 31 48 214 18.1 1 0 19 20 115 36 51 145 14.6 1 1 21 29 141 42 53 119 15.4 0 1 21 25 165 21 29 222 15.4 0 1 21 25 165 21 29 222 17.6 1 1 19 20 110 25 55 159 13.35 0 1 25 20 118 32 54 165 19.1 0 0 21 16 158 26 43 249 15.35 1 1 20 20 146 28 51 125 7.6 0 0 25 20 49 32 20 122 13.4 1 0 19 23 90 41 79 186 13.9 1 0 20 18 121 29 39 148 19.1 0 1 22 25 155 33 61 274 15.25 1 0 19 18 104 17 55 172 12.9 1 1 20 19 147 13 30 84 16.1 1 0 19 25 110 32 55 168 17.35 1 0 19 25 108 30 22 102 13.15 1 0 18 25 113 34 37 106 12.15 1 0 19 24 115 59 2 2 12.6 1 1 21 19 61 13 38 139 10.35 1 1 19 26 60 23 27 95 15.4 1 1 20 10 109 10 56 130 9.6 1 1 20 17 68 5 25 72 18.2 1 0 19 13 111 31 39 141 13.6 1 0 19 17 77 19 33 113 14.85 1 1 22 30 73 32 43 206 14.75 0 0 21 25 151 30 57 268 14.1 1 0 19 4 89 25 43 175 14.9 1 0 19 16 78 48 23 77 16.25 1 0 19 21 110 35 44 125 19.25 0 1 23 23 220 67 54 255 13.6 1 1 19 22 65 15 28 111 13.6 0 0 20 17 141 22 36 132 15.65 1 0 19 20 117 18 39 211 12.75 0 1 22 20 122 33 16 92 14.6 1 0 19 22 63 46 23 76 9.85 0 1 25 16 44 24 40 171 12.65 1 1 19 23 52 14 24 83 11.9 1 1 20 16 62 23 29 119 19.2 1 0 19 0 131 12 78 266 16.6 1 1 19 18 101 38 57 186 11.2 1 1 20 25 42 12 37 50 15.25 0 1 20 23 152 28 27 117 11.9 0 0 21 12 107 41 61 219 13.2 1 0 19 18 77 12 27 246 16.35 0 0 21 24 154 31 69 279 12.4 0 1 23 11 103 33 34 148 15.85 1 1 19 18 96 34 44 137 14.35 0 0 21 14 154 41 21 130 18.15 0 1 22 23 175 21 34 181 11.15 1 1 20 24 57 20 39 98 15.65 1 0 18 29 112 44 51 226 17.75 0 0 21 18 143 52 34 234 7.65 1 0 20 15 49 7 31 138 12.35 0 1 21 29 110 29 13 85 15.6 0 1 21 16 131 11 12 66 19.3 0 0 21 19 167 26 51 236 15.2 1 0 19 22 56 24 24 106 17.1 0 0 21 16 137 7 19 135 15.6 1 1 19 23 86 60 30 122 18.4 0 1 21 23 121 13 81 218 19.05 0 0 21 19 149 20 42 199 18.55 0 0 22 4 168 52 22 112 19.1 0 0 21 20 140 28 85 278 13.1 1 1 22 24 88 25 27 94 12.85 0 1 22 20 168 39 25 113 9.5 0 1 22 4 94 9 22 84 4.5 0 1 22 24 51 19 19 86 11.85 1 0 21 22 48 13 14 62 13.6 0 1 22 16 145 60 45 222 11.7 0 1 23 3 66 19 45 167 12.4 1 1 19 15 85 34 28 82 13.35 0 0 22 24 109 14 51 207 11.4 1 0 21 17 63 17 41 184 14.9 1 1 19 20 102 45 31 83 19.9 1 0 19 27 162 66 74 183 17.75 0 1 20 23 128 24 24 85 11.2 1 1 20 26 86 48 19 89 14.6 1 1 18 23 114 29 51 225 17.6 0 0 21 17 164 -2 73 237 14.05 0 1 21 20 119 51 24 102 16.1 0 0 20 22 126 2 61 221 13.35 0 1 20 19 132 24 23 128 11.85 0 1 21 24 142 40 14 91 11.95 0 0 21 19 83 20 54 198 14.75 1 1 19 23 94 19 51 204 15.15 1 0 19 15 81 16 62 158 13.2 0 1 21 27 166 20 36 138 16.85 1 0 19 26 110 40 59 226 7.85 1 1 19 22 64 27 24 44 7.7 0 0 24 22 93 25 26 196 12.6 1 0 19 18 104 49 54 83 7.85 1 1 19 15 105 39 39 79 10.95 1 1 20 22 49 61 16 52 12.35 1 0 19 27 88 19 36 105 9.95 1 1 19 10 95 67 31 116 14.9 1 1 19 20 102 45 31 83 16.65 1 0 19 17 99 30 42 196 13.4 1 1 19 23 63 8 39 153 13.95 1 0 19 19 76 19 25 157 15.7 1 0 20 13 109 52 31 75 16.85 1 1 20 27 117 22 38 106 10.95 1 1 19 23 57 17 31 58 15.35 1 0 21 16 120 33 17 75 12.2 1 1 19 25 73 34 22 74 15.1 1 0 19 2 91 22 55 185 17.75 1 0 19 26 108 30 62 265 15.2 1 1 21 20 105 25 51 131 14.6 0 0 22 23 117 38 30 139 16.65 1 0 19 22 119 26 49 196 8.1 1 1 19 24 31 13 16 78
Names of X columns:
TOT programma gender age NUMERACYTOT LFM PRH CH Blogs
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
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation