Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1 110.115 110.661 100.294 107.711 1 114.151 115.626 109.764 113.241 1 122.563 121.828 120.711 121.998 1 136.114 137.409 131.551 135.136 1 159.863 171.274 145.023 157.641 1 210.638 238.258 177.164 205.875 1 219.929 251.688 190.269 216.347 1 255.015 296.637 219.996 251.435 1 242.351 296.679 218.186 243.588 1 220.855 256.573 191.582 217.678 1 215.9 244.361 204.484 216.346 1 239.951 274.37 219.318 239.488 2 110.439 113.149 100.578 108.313 2 114.069 116.697 108.502 113.015 2 124.143 122.603 121.37 123.239 2 136.177 138.866 131.422 135.336 2 164.488 177.848 148.287 162.182 2 212.831 241.42 174.947 207.085 2 222.144 255.734 196.606 219.825 2 253.493 299.882 223.847 252.091 2 238.172 285.712 206.917 236.447 2 220.127 257.917 195.727 218.478 2 217.141 255.116 208.73 220.221 2 240.436 275.671 213.558 238.741 3 100 100 100 100 3 111.054 113.853 97.9592 108.124 3 114.798 119.368 109.211 113.998 3 126.574 123.803 120.473 124.666 3 136.883 135.802 131.112 135.284 3 172.288 185.538 147.732 167.86 3 214.227 242.44 179.407 209.204 3 224.73 257.646 197.796 221.956 3 255.976 292.588 227.227 252.946 3 226.723 270.085 197.833 224.906 3 215.471 253.316 194.766 214.815 3 219.459 256.46 210.264 222.182 3 241.588 270.831 214.026 238.5 4 102.815 101.542 100.254 102 4 112.319 115.143 100.107 109.615 4 114.537 120.264 113.097 114.936 4 128.069 127.692 122.204 126.54 4 139.095 139.408 131.193 137.144 4 181.098 193.704 151.23 175.245 4 216.573 248.809 181.625 212.246 4 228.912 263.016 205.874 227.184 4 255.878 292.523 226.757 252.773 4 225.84 261.006 194.438 221.934 4 214.691 257.496 194.576 215.143 4 222.898 258.249 214.211 225.455 4 241.512 275.141 225.59 242.116 5 104.301 102.179 102.839 103.65 5 113.607 116.923 102.865 111.34 5 114.118 118.74 112.18 114.245 5 128.101 128.336 124.943 127.336 5 141.551 142.191 136.448 140.349 5 186.026 203.366 150.278 179.32 5 217.504 254.991 188.871 215.466 5 231.613 265.367 206.229 229.247 5 254.149 290.063 223.928 250.677 5 225.751 266.44 202.508 224.903 5 216.2 264.861 198.563 218.381 5 225.478 256.327 214.169 226.42 5 243.05 277.59 227.637 243.923 6 104.964 105.494 104.726 104.974 6 112.716 116.638 102.719 110.717 6 113.814 116.522 114.855 114.437 6 128.752 128.718 125.276 127.871 6 144.647 146.027 138.433 143.264 6 191.144 213.692 154.789 184.979 6 219.151 255.458 189.866 216.693 6 235.936 271.406 208.473 233.33 6 252.408 296.831 220.682 250.105 6 226.192 267.075 196.651 223.798 6 219.85 257.795 201.679 219.962 6 228.098 259.192 213.656 228.287 6 246.469 276.357 229 245.813 7 104.83 106.14 103.387 104.641 7 113.126 116.227 103.921 111.217 7 115.232 116.967 114.53 115.286 7 129.991 130.539 130.192 130.115 7 147.403 145.695 136.323 144.381 7 196.021 220.819 153.029 188.482 7 220.494 261.125 192.114 219.019 7 239.005 278.478 211.102 236.987 7 252.503 296.742 227.654 251.788 7 220.037 263.672 191.446 218.529 7 220.182 251.318 201.506 218.933 7 230.729 260.776 219.028 231.349 7 248.64 279.389 226.841 247.143 8 105.878 106.371 101.746 104.902 8 112.818 115.942 105.751 111.452 8 115.945 118.061 115.328 116.071 8 133.236 132.864 131.595 132.773 8 148.778 148.469 137.453 145.881 8 200.338 225.005 157.658 192.86 8 220.484 258.58 189.665 217.924 8 242.293 284.415 211.503 240.027 8 253.733 296.479 218.398 250.212 8 220.406 259.121 190.056 217.521 8 220.283 243.526 204.453 218.36 8 230.535 261.166 217.602 231.015 8 251.147 274.787 221.488 246.381 9 107.542 107.249 100.371 105.695 9 112.565 116.42 106.746 111.611 9 117.543 118.711 117.973 117.807 9 134.689 134.529 133.091 134.265 9 149.123 152.221 137.072 146.497 9 202.319 229.096 161.039 195.475 9 220.269 257.981 191.006 217.978 9 248.077 287.685 218.055 245.433 9 252.299 295.557 213.639 248.073 9 223.551 262.711 190.322 219.971 9 216.675 247.503 206.552 217.72 9 229.735 265.351 220.635 232.241 10 107.954 109.481 101.337 106.489 10 112.698 113.365 108.454 111.717 10 118.205 119.223 117.863 118.255 10 135.058 135.166 133.167 134.596 10 150.925 157.061 139.485 148.857 10 204.148 233.982 165.599 198.4 10 222.524 257.756 186.398 218.186 10 248.956 287.97 221.076 246.641 10 248.838 288.037 212.71 244.468 10 223.373 265.838 203.701 223.841 10 217.808 256.9 205.642 219.934 10 233.148 261.627 222.011 233.688 11 108.09 111.951 102.307 107.146 11 113.701 112.709 107.724 112.062 11 119.899 119.196 116.582 118.969 11 135.615 133.458 131.858 134.38 11 152.195 160.782 142.049 150.78 11 205.288 234.529 171.248 200.598 11 221.905 257.984 189.577 218.54 11 252.358 290.44 226.743 250.328 11 247.559 287.377 217.355 244.727 11 224.678 265.766 200.524 223.764 11 217.66 261.806 205.679 220.842 11 235.221 266.932 224.948 236.667 12 109.19 111.972 101.794 107.695 12 113.844 115.609 108.936 112.842 12 121.35 120.729 117.645 120.333 12 136.088 135.621 132.5 135.121 12 155.762 164.581 141.315 153.293 12 206.439 238.753 172.249 202.121 12 222.286 252.604 190.244 217.886 12 254.122 292.298 223.179 250.849 12 245.331 290.101 217.786 244.034 12 223.629 269.162 200.524 223.664 12 217.951 260.758 204.583 220.584 12 237.46 268.695 225.566 238.439
Names of X columns:
month MSF SSF NS TOT
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
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, mysum$coefficients[i,1], 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,mysum$coefficients[i,1]) a<-table.element(a, round(mysum$coefficients[i,2],6)) a<-table.element(a, round(mysum$coefficients[i,3],4)) a<-table.element(a, round(mysum$coefficients[i,4],6)) a<-table.element(a, round(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, sqrt(mysum$r.squared)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a, mysum$r.squared) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a, mysum$adj.r.squared) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a, mysum$fstatistic[1]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, mysum$fstatistic[2]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, mysum$fstatistic[3]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a, 1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3])) 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, mysum$sigma) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a, sum(myerror*myerror)) 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,x[i]) a<-table.element(a,x[i]-mysum$resid[i]) a<-table.element(a,mysum$resid[i]) 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,gqarr[mypoint-kp3+1,1]) a<-table.element(a,gqarr[mypoint-kp3+1,2]) a<-table.element(a,gqarr[mypoint-kp3+1,3]) 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,numsignificant1) a<-table.element(a,numsignificant1/numgqtests) 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,numsignificant5) a<-table.element(a,numsignificant5/numgqtests) 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,numsignificant10) a<-table.element(a,numsignificant10/numgqtests) 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