Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
89 149 96 18 68 7.5 1.5 12.9 99 139 70 31 39 6 2.1 12.2 113 148 88 39 32 6.5 2.1 12.8 93 158 114 46 62 1 1.9 7.4 96 128 69 31 33 1 1.6 6.7 100 224 176 67 52 5.5 2.1 12.6 120 159 114 35 62 8.5 2.1 14.8 85 105 121 52 77 6.5 2.2 13.3 100 159 110 77 76 4.5 1.5 11.1 101 167 158 37 41 2 1.9 8.2 73 165 116 32 48 5 2.2 11.4 97 159 181 36 63 0.5 1.6 6.4 91 119 77 38 30 5 1.5 10.6 95 176 141 69 78 5 1.9 12 115 54 35 21 19 2.5 0.1 6.3 128 91 80 26 31 5 2.2 11.3 92 163 152 54 66 5.5 1.8 11.9 102 124 97 36 35 3.5 1.6 9.3 104 137 99 42 42 3 2.2 9.6 107 121 84 23 45 4 2.1 10 102 148 101 112 25 6.5 1.6 13.8 106 221 107 35 44 4.5 1.9 10.8 113 149 112 47 54 5.5 1.8 11.7 121 244 171 37 74 4 2.4 10.9 128 148 137 109 80 7.5 2.4 16.1 88 92 77 24 42 7 2.5 13.4 99 150 66 20 61 4 1.9 9.9 86 153 93 22 41 5.5 2.1 11.5 66 94 105 23 46 2.5 1.9 8.3 101 156 131 32 39 5.5 2.1 11.7 88 132 102 30 34 3.5 1.5 9 118 161 161 92 51 2.5 1.9 9.7 101 105 120 43 42 4.5 2.1 10.8 88 97 127 55 31 4.5 1.5 10.3 103 151 77 16 39 4.5 2.1 10.4 98 131 108 49 20 6 2.1 12.7 105 166 85 71 49 2.5 1.8 9.3 105 157 168 43 53 5 2.4 11.8 66 111 48 29 31 0 2.1 5.9 92 145 152 56 39 5 1.9 11.4 123 162 75 46 54 6.5 2.1 13 65 163 107 19 49 5 1.9 10.8 102 59 62 23 34 6 2.4 12.3 103 187 121 59 46 4.5 2.1 11.3 84 109 124 30 55 5.5 2.2 11.8 91 90 72 61 42 1 2.2 7.9 152 105 40 7 50 7.5 1.8 12.7 114 83 58 38 13 6 2.1 12.3 88 116 97 32 37 5 2.4 11.6 99 42 88 16 25 1 2.2 6.7 61 148 126 19 30 5 2.1 10.9 105 155 104 22 28 6.5 1.5 12.1 81 125 148 48 45 7 1.9 13.3 113 116 146 23 35 4.5 1.8 10.1 107 128 80 26 28 0 1.8 5.7 89 138 97 33 41 8.5 1.6 14.3 85 49 25 9 6 3.5 1.2 8 99 96 99 24 45 7.5 1.8 13.3 87 164 118 34 73 3.5 1.5 9.3 101 162 58 48 17 6 2.1 12.5 129 99 63 18 40 1.5 2.4 7.6 73 202 139 43 64 9 2.4 15.9 107 186 50 33 37 3.5 1.5 9.2 73 66 60 28 25 3.5 1.8 9.1 104 183 152 71 65 4 2.1 11.1 111 214 142 26 100 6.5 2.2 13 83 188 94 67 28 7.5 2.1 14.5 61 104 66 34 35 6 1.9 12.2 112 177 127 80 56 5 2.1 12.3 103 126 67 29 29 5.5 1.9 11.4 92 99 75 59 59 7.5 2.4 14.6 80 139 128 32 50 6.5 1.9 12.6 95 78 41 47 3 NA 1.9 NA 98 162 146 43 59 6.5 2.1 13 107 108 69 38 27 6.5 1.8 12.6 93 159 186 29 61 7 2.1 13.2 80 74 81 36 28 3.5 2.4 9.9 74 110 85 32 51 1.5 2.1 7.7 90 96 54 35 35 4 2.2 10.5 76 116 46 21 29 7.5 2.1 13.4 100 87 106 29 48 4.5 2.2 10.9 86 97 34 12 25 0 1.6 4.3 107 127 60 37 44 3.5 2.4 10.3 91 106 95 37 64 5.5 2.1 11.8 81 80 57 47 32 5 1.9 11.2 129 74 62 51 20 4.5 2.4 11.4 86 91 36 32 28 2.5 2.1 8.6 99 133 56 21 34 7.5 1.8 13.2 87 74 54 13 31 7 2.1 12.6 115 114 64 14 26 0 1.8 5.6 96 140 76 -2 58 4.5 1.9 9.9 78 95 98 20 23 3 1.9 8.8 86 98 88 24 21 1.5 2.4 7.7 89 121 35 11 21 3.5 1.8 9 92 126 102 23 33 2.5 1.8 7.3 83 98 61 24 16 5.5 2.1 11.4 97 95 80 14 20 8 2.1 13.6 123 110 49 52 37 1 2.4 7.9 109 70 78 15 35 5 1.9 10.7 84 102 90 23 33 4.5 1.8 10.3 105 130 55 35 41 3 2.2 9.6 89 96 96 24 40 8 2.4 14.2 107 102 43 39 35 2.5 1.8 8.5 101 100 52 29 28 7 2.4 13.5 103 52 54 8 22 1 1.9 6.4 77 98 51 18 44 3.5 2.4 9.6 102 118 51 24 27 5.5 2.1 11.6 100 99 38 19 17 5.5 1.9 11.1
Names of X columns:
PERFTOT LFM Blog PRH CH Ex PA 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
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation