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