Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
149 26 8 7 4 152 51 18 18 9 139 57 18 20 4 148 37 12 9 5 158 67 24 19 4 128 43 16 12 4 224 52 19 16 9 159 52 16 17 8 105 43 15 9 11 159 84 28 28 4 167 67 21 20 4 165 49 18 16 6 159 70 22 22 4 119 52 19 17 8 176 58 22 12 4 54 68 25 18 4 91 62 20 20 11 163 43 16 12 4 124 56 19 16 4 137 56 18 16 6 121 74 26 21 6 153 65 24 15 4 148 63 20 17 8 221 58 19 17 5 188 57 19 17 4 149 63 23 18 9 244 53 18 15 4 148 57 16 20 7 92 51 18 13 10 150 64 21 21 4 153 53 20 12 4 94 29 15 6 7 156 54 19 13 12 146 51 27 6 4 132 58 19 19 7 161 43 7 12 5 105 51 20 14 8 97 53 20 13 5 151 54 19 12 4 131 56 19 17 9 166 61 20 19 7 157 47 18 10 4 111 39 14 10 4 145 48 17 11 4 162 50 17 11 4 163 35 8 10 4 59 30 9 7 7 187 68 22 22 4 109 49 20 12 7 90 61 20 18 4 105 67 22 20 4 83 47 22 9 4 116 56 22 16 4 42 50 16 14 8 148 43 14 11 4 155 67 24 20 4 125 62 21 17 4 116 57 20 14 4 128 41 20 8 7 138 54 18 16 12 49 45 14 11 4 96 48 19 10 4 164 61 24 15 4 162 56 19 15 5 99 41 16 10 15 202 43 16 10 5 186 53 16 18 10 66 44 14 10 9 183 66 22 22 8 214 58 21 16 4 188 46 15 10 5 104 37 14 7 4 177 51 15 16 9 126 51 14 16 4 76 56 20 16 10 99 66 21 22 4 157 45 17 13 7 139 37 14 5 4 78 59 19 18 6 162 42 16 10 7 108 38 13 8 5 159 66 26 16 4 74 34 13 8 4 110 53 18 16 4 96 49 15 14 4 116 55 18 15 4 87 49 21 9 4 97 59 17 21 6 127 40 18 7 10 106 58 20 17 7 80 60 18 18 4 74 63 25 16 4 91 56 20 16 7 133 54 19 14 4 74 52 18 15 8 114 34 12 8 11 140 69 22 22 6 95 32 16 5 14 98 48 18 13 5 121 67 23 22 4 126 58 20 18 8 98 57 20 15 9 95 42 16 11 4 110 64 22 19 4 70 58 19 19 5 102 66 23 21 4 86 26 6 4 5 130 61 19 17 4 96 52 24 10 4 102 51 19 13 7 100 55 15 15 10 94 50 18 11 4 52 60 18 20 5 98 56 22 13 4 118 63 23 18 4 99 61 18 20 4 48 52 17 15 6 50 16 6 4 4 150 46 22 9 8 154 56 20 18 5 109 52 16 12 4 68 55 16 17 17 194 50 17 12 4 158 59 20 16 4 159 60 23 17 8 67 52 18 14 4 147 44 13 13 7 39 67 22 20 4 100 52 20 16 4 111 55 20 15 5 138 37 13 10 7 101 54 16 16 4 131 72 25 21 4 101 51 16 15 7 114 48 15 16 11 165 60 19 19 7 114 50 19 9 4 111 63 24 19 4 75 33 9 7 4 82 67 22 23 4 121 46 15 14 4 32 54 22 10 4 150 59 22 16 6 117 61 24 12 8 71 33 12 10 23 165 47 21 7 4 154 69 25 20 8 126 52 26 9 6 138 55 19 14 4 149 55 21 12 4 145 41 14 10 7 120 73 28 19 4 138 51 16 16 4 109 52 21 11 4 132 50 16 15 4 172 51 16 14 10 169 60 25 11 6 114 56 21 14 5 156 56 22 15 5 172 29 9 7 4 68 66 20 22 4 89 66 19 19 5 167 73 24 22 5 113 55 22 11 5 115 64 22 19 5 78 40 12 9 4 118 46 17 11 6 87 58 18 17 4 173 43 10 12 4 2 61 22 17 4 162 51 24 10 9 49 50 18 17 18 122 52 18 13 6 96 54 23 11 5 100 66 21 19 4 82 61 21 21 11 100 80 28 24 4 115 51 17 13 10 141 56 21 16 6 165 56 21 13 8 165 56 20 15 8 110 53 18 15 6 118 47 17 11 8 158 25 7 7 4 146 47 17 13 4 49 46 14 13 9 90 50 18 12 9 121 39 14 8 5 155 51 23 7 4 104 58 20 17 4 147 35 14 9 15 110 58 17 18 10 108 60 21 17 9 113 62 23 17 7 115 63 24 18 9 61 53 21 12 6 60 46 14 14 4 109 67 24 22 7 68 59 16 19 4 111 64 21 21 7 77 38 8 10 4 73 50 17 16 15 151 48 18 11 4 89 48 17 15 9 78 47 16 12 4 110 66 22 21 4 220 47 17 22 28 65 63 21 20 4 141 58 20 15 4 117 44 20 9 4 122 51 19 15 5 63 43 8 14 4 44 55 19 11 4 52 38 11 9 12 62 56 15 18 5 131 45 13 12 4 101 50 18 11 6 42 54 19 14 6 152 57 23 10 5 107 60 20 18 4 77 55 22 11 4 154 56 19 14 4 103 49 16 16 10 96 37 11 11 7 154 43 11 8 4 175 59 21 16 4 57 46 14 13 7 112 51 21 12 4 143 58 20 17 4 49 64 21 23 12 110 53 20 14 5 131 48 19 10 8 167 51 19 16 6 56 47 18 11 17 137 59 20 16 4 86 62 21 19 5 121 62 22 17 4 149 51 19 12 5 168 64 23 17 5 140 52 16 11 6 88 67 23 19 4 168 50 18 12 4 94 54 23 8 4 51 58 20 17 6 48 56 20 13 8 145 63 23 17 10 66 31 13 7 4 85 65 21 23 5 109 71 26 18 4 63 50 18 13 4 102 57 19 17 4 162 47 18 13 16 128 54 19 13 4 86 47 18 8 7 114 57 19 16 4 164 43 13 14 4 119 41 10 13 14 126 63 21 19 5 132 63 24 15 5 142 56 21 15 5 83 51 23 8 5 94 50 18 14 7 81 22 11 7 19 166 41 16 11 16 110 59 20 17 4 64 56 20 19 4 93 66 26 17 7 104 53 21 12 9 105 42 12 12 5 49 52 15 18 14 88 54 18 16 4 95 44 14 15 16 102 62 18 20 10 99 53 16 16 5 63 50 19 12 6 76 36 7 10 4 109 76 21 28 4 117 66 24 19 4 57 62 21 18 5 120 59 20 19 4 73 47 22 8 4 91 55 17 17 5 108 58 19 16 4 105 60 20 18 4 117 44 16 12 5 119 57 20 17 8 31 45 16 13 15
Names of X columns:
LFM AMS.I AMS.I2 AMS.I3 AMS.A
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