Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
12.9 68 149 18 7.4 55 152 7 12.2 39 139 31 12.8 32 148 39 7.4 62 158 46 6.7 33 128 31 12.6 52 224 67 14.8 62 159 35 13.3 77 105 52 11.1 76 159 77 8.2 41 167 37 11.4 48 165 32 6.4 63 159 36 10.6 30 119 38 12.0 78 176 69 6.3 19 54 21 11.3 31 91 26 11.9 66 163 54 9.3 35 124 36 9.6 42 137 42 10.0 45 121 23 6.4 21 153 34 13.8 25 148 112 10.8 44 221 35 13.8 69 188 47 11.7 54 149 47 10.9 74 244 37 16.1 80 148 109 13.4 42 92 24 9.9 61 150 20 11.5 41 153 22 8.3 46 94 23 11.7 39 156 32 6.1 63 146 7 9.0 34 132 30 9.7 51 161 92 10.8 42 105 43 10.3 31 97 55 10.4 39 151 16 12.7 20 131 49 9.3 49 166 71 11.8 53 157 43 5.9 31 111 29 11.4 39 145 56 13.0 54 162 46 10.8 49 163 19 12.3 34 59 23 11.3 46 187 59 11.8 55 109 30 7.9 42 90 61 12.7 50 105 7 12.3 13 83 38 11.6 37 116 32 6.7 25 42 16 10.9 30 148 19 12.1 28 155 22 13.3 45 125 48 10.1 35 116 23 5.7 28 128 26 14.3 41 138 33 8.0 6 49 9 13.3 45 96 24 9.3 73 164 34 12.5 17 162 48 7.6 40 99 18 15.9 64 202 43 9.2 37 186 33 9.1 25 66 28 11.1 65 183 71 13.0 100 214 26 14.5 28 188 67 12.2 35 104 34 12.3 56 177 80 11.4 29 126 29 8.8 43 76 16 14.6 59 99 59 7.3 52 157 58 12.6 50 139 32 13.0 59 162 43 12.6 27 108 38 13.2 61 159 29 9.9 28 74 36 7.7 51 110 32 10.5 35 96 35 13.4 29 116 21 10.9 48 87 29 4.3 25 97 12 10.3 44 127 37 11.8 64 106 37 11.2 32 80 47 11.4 20 74 51 8.6 28 91 32 13.2 34 133 21 12.6 31 74 13 5.6 26 114 14 9.9 58 140 -2 8.8 23 95 20 7.7 21 98 24 9.0 21 121 11 7.3 33 126 23 11.4 16 98 24 13.6 20 95 14 7.9 37 110 52 10.7 35 70 15 10.3 33 102 23 8.3 27 86 19 9.6 41 130 35 14.2 40 96 24 8.5 35 102 39 13.5 28 100 29 4.9 32 94 13 6.4 22 52 8 9.6 44 98 18 11.6 27 118 24 11.1 17 99 19 4.35 12 48 23 12.7 45 50 16 18.1 37 150 33 17.85 37 154 32 16.6 108 109 37 12.6 10 68 14 17.1 68 194 52 19.1 72 158 75 16.1 143 159 72 13.35 9 67 15 18.4 55 147 29 14.7 17 39 13 10.6 37 100 40 12.6 27 111 19 16.2 37 138 24 13.6 58 101 121 18.9 66 131 93 14.1 21 101 36 14.5 19 114 23 16.15 78 165 85 14.75 35 114 41 14.8 48 111 46 12.45 27 75 18 12.65 43 82 35 17.35 30 121 17 8.6 25 32 4 18.4 69 150 28 16.1 72 117 44 11.6 23 71 10 17.75 13 165 38 15.25 61 154 57 17.65 43 126 23 15.6 22 138 26 16.35 51 149 36 17.65 67 145 22 13.6 36 120 40 11.7 21 138 18 14.35 44 109 31 14.75 45 132 11 18.25 34 172 38 9.9 36 169 24 16 72 114 37 18.25 39 156 37 16.85 43 172 22 14.6 25 68 15 13.85 56 89 2 18.95 80 167 43 15.6 40 113 31 14.85 73 115 29 11.75 34 78 45 18.45 72 118 25 15.9 42 87 4 17.1 61 173 31 16.1 23 2 -4 19.9 74 162 66 10.95 16 49 61 18.45 66 122 32 15.1 9 96 31 15 41 100 39 11.35 57 82 19 15.95 48 100 31 18.1 51 115 36 14.6 53 141 42 15.4 29 165 21 15.4 29 165 21 17.6 55 110 25 13.35 54 118 32 19.1 43 158 26 15.35 51 146 28 7.6 20 49 32 13.4 79 90 41 13.9 39 121 29 19.1 61 155 33 15.25 55 104 17 12.9 30 147 13 16.1 55 110 32 17.35 22 108 30 13.15 37 113 34 12.15 2 115 59 12.6 38 61 13 10.35 27 60 23 15.4 56 109 10 9.6 25 68 5 18.2 39 111 31 13.6 33 77 19 14.85 43 73 32 14.75 57 151 30 14.1 43 89 25 14.9 23 78 48 16.25 44 110 35 19.25 54 220 67 13.6 28 65 15 13.6 36 141 22 15.65 39 117 18 12.75 16 122 33 14.6 23 63 46 9.85 40 44 24 12.65 24 52 14 11.9 29 62 23 19.2 78 131 12 16.6 57 101 38 11.2 37 42 12 15.25 27 152 28 11.9 61 107 41 13.2 27 77 12 16.35 69 154 31 12.4 34 103 33 15.85 44 96 34 14.35 21 154 41 18.15 34 175 21 11.15 39 57 20 15.65 51 112 44 17.75 34 143 52 7.65 31 49 7 12.35 13 110 29 15.6 12 131 11 19.3 51 167 26 15.2 24 56 24 17.1 19 137 7 15.6 30 86 60 18.4 81 121 13 19.05 42 149 20 18.55 22 168 52 19.1 85 140 28 13.1 27 88 25 12.85 25 168 39 9.5 22 94 9 4.5 19 51 19 11.85 14 48 13 13.6 45 145 60 11.7 45 66 19 12.4 28 85 34 13.35 51 109 14 11.4 41 63 17 14.9 31 102 45 19.9 74 162 66 17.75 24 128 24 11.2 19 86 48 14.6 51 114 29 17.6 73 164 -2 14.05 24 119 51 16.1 61 126 2 13.35 23 132 24 11.85 14 142 40 11.95 54 83 20 14.75 51 94 19 15.15 62 81 16 13.2 36 166 20 16.85 59 110 40 7.85 24 64 27 7.7 26 93 25 12.6 54 104 49 7.85 39 105 39 10.95 16 49 61 12.35 36 88 19 9.95 31 95 67 14.9 31 102 45 16.65 42 99 30 13.4 39 63 8 13.95 25 76 19 15.7 31 109 52 16.85 38 117 22 10.95 31 57 17 15.35 17 120 33 12.2 22 73 34 15.1 55 91 22 17.75 62 108 30 15.2 51 105 25 14.6 30 117 38 16.65 49 119 26 8.1 16 31 13
Names of X columns:
TOT CH LFM PRH
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
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation