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