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