Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
0.5 48 41 23 12 7.5 50 146 16 45 9.0 150 182 33 37 9.5 154 192 32 37 8.5 109 263 37 108 7.0 68 35 14 10 8.0 194 439 52 68 10.0 158 214 75 72 7.0 159 341 72 143 8.5 67 58 15 9 9.0 147 292 29 55 9.5 39 85 13 17 4.0 100 200 40 37 6.0 111 158 19 27 8.0 138 199 24 37 5.5 101 297 121 58 9.5 131 227 93 66 7.5 101 108 36 21 7.0 114 86 23 19 7.5 165 302 85 78 8.0 114 148 41 35 7.0 111 178 46 48 7.0 75 120 18 27 6.0 82 207 35 43 10.0 121 157 17 30 2.5 32 128 4 25 9.0 150 296 28 69 8.0 117 323 44 72 6.0 71 79 10 23 8.5 165 70 38 13 6.0 154 146 57 61 9.0 126 246 23 43 8.0 138 145 26 22 8.0 149 196 36 51 9.0 145 199 22 67 5.5 120 127 40 36 5.0 138 91 18 21 7.0 109 153 31 44 5.5 132 299 11 45 9.0 172 228 38 34 2.0 169 190 24 36 8.5 114 180 37 72 9.0 156 212 37 39 8.5 172 269 22 43 9.0 68 130 15 25 7.5 89 179 2 56 10.0 167 243 43 80 9.0 113 190 31 40 7.5 115 299 29 73 6.0 78 121 45 34 10.5 118 137 25 72 8.5 87 305 4 42 8.0 173 157 31 61 10.0 2 96 -4 23 10.5 162 183 66 74 6.5 49 52 61 16 9.5 122 238 32 66 8.5 96 40 31 9 7.5 100 226 39 41 5.0 82 190 19 57 8.0 100 214 31 48 10.0 115 145 36 51 7.0 141 119 42 53 7.5 165 222 21 29 7.5 165 222 21 29 9.5 110 159 25 55 6.0 118 165 32 54 10.0 158 249 26 43 7.0 146 125 28 51 3.0 49 122 32 20 6.0 90 186 41 79 7.0 121 148 29 39 10.0 155 274 33 61 7.0 104 172 17 55 3.5 147 84 13 30 8.0 110 168 32 55 10.0 108 102 30 22 5.5 113 106 34 37 6.0 115 2 59 2 6.5 61 139 13 38 6.5 60 95 23 27 8.5 109 130 10 56 4.0 68 72 5 25 9.5 111 141 31 39 8.0 77 113 19 33 8.5 73 206 32 43 5.5 151 268 30 57 7.0 89 175 25 43 9.0 78 77 48 23 8.0 110 125 35 44 10.0 220 255 67 54 8.0 65 111 15 28 6.0 141 132 22 36 8.0 117 211 18 39 5.0 122 92 33 16 9.0 63 76 46 23 4.5 44 171 24 40 8.5 52 83 14 24 7.0 62 119 23 29 9.5 131 266 12 78 8.5 101 186 38 57 7.5 42 50 12 37 7.5 152 117 28 27 5.0 107 219 41 61 7.0 77 246 12 27 8.0 154 279 31 69 5.5 103 148 33 34 8.5 96 137 34 44 7.5 154 130 41 21 9.5 175 181 21 34 7.0 57 98 20 39 8.0 112 226 44 51 8.5 143 234 52 34 3.5 49 138 7 31 6.5 110 85 29 13 6.5 131 66 11 12 10.5 167 236 26 51 8.5 56 106 24 24 8.0 137 135 7 19 10.0 86 122 60 30 10.0 121 218 13 81 9.5 149 199 20 42 9.0 168 112 52 22 10.0 140 278 28 85 7.5 88 94 25 27 4.5 168 113 39 25 4.5 94 84 9 22 0.5 51 86 19 19 6.5 48 62 13 14 4.5 145 222 60 45 5.5 66 167 19 45 5.0 85 82 34 28 6.0 109 207 14 51 4.0 63 184 17 41 8.0 102 83 45 31 10.5 162 183 66 74 8.5 128 85 24 24 6.5 86 89 48 19 8.0 114 225 29 51 8.5 164 237 -2 73 5.5 119 102 51 24 7.0 126 221 2 61 5.0 132 128 24 23 3.5 142 91 40 14 5.0 83 198 20 54 9.0 94 204 19 51 8.5 81 158 16 62 5.0 166 138 20 36 9.5 110 226 40 59 3.0 64 44 27 24 1.5 93 196 25 26 6.0 104 83 49 54 0.5 105 79 39 39 6.5 49 52 61 16 7.5 88 105 19 36 4.5 95 116 67 31 8.0 102 83 45 31 9.0 99 196 30 42 7.5 63 153 8 39 8.5 76 157 19 25 7.0 109 75 52 31 9.5 117 106 22 38 6.5 57 58 17 31 9.5 120 75 33 17 6.0 73 74 34 22 8.0 91 185 22 55 9.5 108 265 30 62 8.0 105 131 25 51 8.0 117 139 38 30 9.0 119 196 26 49 5.0 31 78 13 16
Names of X columns:
EX LFM B 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
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation