Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
'7.5' 68 18 149 21 0 '6.5' 32 39 148 22 0 '1.0' 62 46 158 18 1 '1.0' 33 31 128 23 1 '5.5' 52 67 224 12 1 '8.5' 62 35 159 20 0 '6.5' 77 52 105 22 1 '4.5' 76 77 159 21 1 '2.0' 41 37 167 19 1 '5.0' 48 32 165 22 1 '0.5' 63 36 159 15 1 '5.0' 78 69 176 19 0 '2.5' 19 21 54 18 0 '5.0' 31 26 91 15 0 '5.5' 66 54 163 20 1 '3.5' 35 36 124 21 0 '4.0' 45 23 121 15 0 '6.5' 25 112 148 23 1 '4.5' 44 35 221 21 0 '5.5' 54 47 149 25 1 '4.0' 74 37 244 9 1 '7.5' 80 109 148 30 1 '7.0' 42 24 92 20 0 '4.0' 61 20 150 23 1 '5.5' 41 22 153 16 0 '2.5' 46 23 94 16 0 '5.5' 39 32 156 19 0 '3.5' 34 30 132 25 1 '2.5' 51 92 161 18 1 '4.5' 42 43 105 23 1 '4.5' 31 55 97 21 1 '4.5' 39 16 151 10 0 '6.0' 20 49 131 14 1 '2.5' 49 71 166 22 1 '5.0' 53 43 157 26 0 '6.5' 54 46 162 24 1 '5.0' 49 19 163 24 1 '6.0' 34 23 59 18 1 '4.5' 46 59 187 23 0 '5.0' 37 32 116 23 1 '1.0' 25 16 42 17 1 '5.0' 30 19 148 19 1 '6.5' 28 22 155 21 1 '7.0' 45 48 125 18 1 '4.5' 35 23 116 27 1 '0.0' 28 26 128 21 0 '8.5' 41 33 138 13 1 '3.5' 6 9 49 8 0 '7.5' 45 24 96 29 1 '3.5' 73 34 164 28 1 '6.0' 17 48 162 23 0 '1.5' 40 18 99 21 0 '9.0' 64 43 202 19 1 '3.5' 37 33 186 19 0 '3.5' 25 28 66 20 1 '4.0' 65 71 183 18 0 '6.5' 100 26 214 19 1 '7.5' 28 67 188 17 1 '6.0' 35 34 104 19 0 '5.0' 56 80 177 25 0 '5.5' 29 29 126 19 0 '3.5' 43 16 76 22 0 '7.5' 59 59 99 23 1 '6.5' 50 32 139 14 0 '6.5' 59 43 162 16 0 '6.5' 27 38 108 24 1 '7.0' 61 29 159 20 0 '3.5' 28 36 74 12 0 '1.5' 51 32 110 24 1 '4.0' 35 35 96 22 0 '7.5' 29 21 116 12 0 '4.5' 48 29 87 22 0 '0.0' 25 12 97 20 1 '3.5' 44 37 127 10 0 '5.5' 64 37 106 23 1 '5.0' 32 47 80 17 1 '4.5' 20 51 74 22 0 '2.5' 28 32 91 24 0 '7.5' 34 21 133 18 0 '7.0' 31 13 74 21 1 '0.0' 26 14 114 20 1 '3.0' 23 20 95 22 0 '3.5' 21 11 121 20 0 '3.0' 41 35 130 17 1 '1.0' 22 8 52 18 0 '5.5' 27 24 118 19 0 '0.5' 12 23 48 23 1 '7.5' 45 16 50 22 1 9 37 33 150 21 1 '9.5' 37 32 154 25 1 '8.5' 108 37 109 30 0 7 10 14 68 17 1 8 68 52 194 27 1 10 72 75 158 23 0 7 143 72 159 23 1 '8.5' 9 15 67 18 0 9 55 29 147 18 0 '9.5' 17 13 39 23 1 4 37 40 100 19 1 6 27 19 111 15 1 8 37 24 138 20 1 '5.5' 58 121 101 16 1 '9.5' 66 93 131 24 1 '7.5' 21 36 101 25 1 7 19 23 114 25 1 '7.5' 78 85 165 19 0 8 35 41 114 19 1 7 48 46 111 16 1 7 27 18 75 19 1 6 43 35 82 19 1 10 30 17 121 23 1 '2.5' 25 4 32 21 1 9 69 28 150 22 0 8 72 44 117 19 1 6 23 10 71 20 1 '8.5' 13 38 165 20 1 6 61 57 154 3 1 9 43 23 126 23 1 8 51 36 149 23 0 9 67 22 145 20 0 '5.5' 36 40 120 15 1 7 44 31 109 16 0 '5.5' 45 11 132 7 0 9 34 38 172 24 1 2 36 24 169 17 0 '8.5' 72 37 114 24 1 9 39 37 156 24 1 '8.5' 43 22 172 19 0 9 25 15 68 25 1 '7.5' 56 2 89 20 1 10 80 43 167 28 1 9 40 31 113 23 0 '7.5' 73 29 115 27 0 6 34 45 78 18 0 '10.5' 72 25 118 28 0 '8.5' 42 4 87 21 1 8 61 31 173 19 0 10 23 -4 2 23 1 '10.5' 74 66 162 27 0 '6.5' 16 61 49 22 1 '9.5' 66 32 122 28 0 '8.5' 9 31 96 25 1 '7.5' 41 39 100 21 0 5 57 19 82 22 0 8 48 31 100 28 1 10 51 36 115 20 0 7 53 42 141 29 1 '7.5' 29 21 165 25 1 '7.5' 29 21 165 25 1 '9.5' 55 25 110 20 1 6 54 32 118 20 1 10 43 26 158 16 0 7 51 28 146 20 1 3 20 32 49 20 0 6 79 41 90 23 0 7 39 29 121 18 0 10 61 33 155 25 1 7 55 17 104 18 0 '3.5' 30 13 147 19 1 8 55 32 110 25 0 10 22 30 108 25 0 '5.5' 37 34 113 25 0 6 2 59 115 24 0 '6.5' 38 13 61 19 1 '6.5' 27 23 60 26 1 '8.5' 56 10 109 10 1 4 25 5 68 17 1 '9.5' 39 31 111 13 0 8 33 19 77 17 0 '8.5' 43 32 73 30 1 '5.5' 57 30 151 25 0 7 43 25 89 4 0 9 23 48 78 16 0 8 44 35 110 21 0 10 54 67 220 23 1 8 28 15 65 22 1 6 36 22 141 17 0 8 39 18 117 20 0 5 16 33 122 20 1 9 23 46 63 22 0 '4.5' 40 24 44 16 1 '8.5' 24 14 52 23 1 '9.5' 78 12 131 0 0 '8.5' 57 38 101 18 1 '7.5' 37 12 42 25 1 '7.5' 27 28 152 23 1 5 61 41 107 12 0 7 27 12 77 18 0 8 69 31 154 24 0 '5.5' 34 33 103 11 1 '8.5' 44 34 96 18 1 '9.5' 34 21 175 23 1 7 39 20 57 24 1 8 51 44 112 29 0 '8.5' 34 52 143 18 0 '3.5' 31 7 49 15 0 '6.5' 13 29 110 29 1 '6.5' 12 11 131 16 1 '10.5' 51 26 167 19 0 '8.5' 24 24 56 22 0 8 19 7 137 16 0 10 30 60 86 23 1 10 81 13 121 23 1 '9.5' 42 20 149 19 0 9 22 52 168 4 0 10 85 28 140 20 0 '7.5' 27 25 88 24 1 '4.5' 25 39 168 20 1 '4.5' 22 9 94 4 1 '0.5' 19 19 51 24 1 '6.5' 14 13 48 22 0 '4.5' 45 60 145 16 1 '5.5' 45 19 66 3 1 5 28 34 85 15 1 6 51 14 109 24 0 4 41 17 63 17 0 8 31 45 102 20 1 '10.5' 74 66 162 27 0 '6.5' 19 48 86 26 1 8 51 29 114 23 1 '8.5' 73 -2 164 17 0 '5.5' 24 51 119 20 1 7 61 2 126 22 0 5 23 24 132 19 1 '3.5' 14 40 142 24 1 5 54 20 83 19 0 9 51 19 94 23 1 '8.5' 62 16 81 15 0 5 36 20 166 27 1 '9.5' 59 40 110 26 0 3 24 27 64 22 1 '1.5' 26 25 93 22 0 6 54 49 104 18 0 '0.5' 39 39 105 15 1 '6.5' 16 61 49 22 1 '7.5' 36 19 88 27 0 '4.5' 31 67 95 10 1 8 31 45 102 20 1 9 42 30 99 17 0 '7.5' 39 8 63 23 1 '8.5' 25 19 76 19 0 7 31 52 109 13 0 '9.5' 38 22 117 27 1 '6.5' 31 17 57 23 1 '9.5' 17 33 120 16 0 6 22 34 73 25 1 8 55 22 91 2 0 '9.5' 62 30 108 26 0 8 51 25 105 20 1 8 30 38 117 23 0 9 49 26 119 22 0 5 16 13 31 24 1
Names of X columns:
Ex CH PRH LFM NUMERACYTOT gender
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