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