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