Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
0 50 12.9 2011 0 68 7.4 2011 62 0 12.2 2011 0 54 12.8 2011 71 0 7.4 2011 54 0 6.7 2011 65 0 12.6 2011 0 73 14.8 2011 52 0 13.3 2011 84 0 11.1 2011 42 0 8.2 2011 66 0 11.4 2011 65 0 6.4 2011 78 0 10.6 2011 0 73 12.0 2011 0 75 6.3 2011 0 72 11.3 2011 66 0 11.9 2011 0 70 9.3 2011 61 0 9.6 2011 0 81 10.0 2011 69 0 13.8 2011 0 71 10.8 2011 72 0 13.8 2011 68 0 11.7 2011 70 0 10.9 2011 68 0 16.1 2011 0 61 13.4 2011 67 0 9.9 2011 0 76 11.5 2011 0 70 8.3 2011 0 60 11.7 2011 72 0 9.0 2011 69 0 9.7 2011 71 0 10.8 2011 62 0 10.3 2011 0 70 10.4 2011 64 0 12.7 2011 58 0 9.3 2011 0 76 11.8 2011 52 0 5.9 2011 59 0 11.4 2011 68 0 13.0 2011 76 0 10.8 2011 65 0 12.3 2011 0 67 11.3 2011 59 0 11.8 2011 69 0 7.9 2011 0 76 12.7 2011 63 0 12.3 2011 75 0 11.6 2011 63 0 6.7 2011 60 0 10.9 2011 73 0 12.1 2011 63 0 13.3 2011 70 0 10.1 2011 0 75 5.7 2011 66 0 14.3 2011 0 63 8.0 2011 63 0 13.3 2011 64 0 9.3 2011 0 70 12.5 2011 0 75 7.6 2011 61 0 15.9 2011 0 60 9.2 2011 62 0 9.1 2011 0 73 11.1 2011 61 0 13.0 2011 66 0 14.5 2011 0 64 12.2 2011 0 59 12.3 2011 0 64 11.4 2011 0 60 8.8 2011 56 0 14.6 2011 66 0 7.3 2011 0 78 12.6 2011 53 0 NA 2011 0 67 13.0 2011 59 0 12.6 2011 0 66 13.2 2011 0 68 9.9 2011 71 0 7.7 2011 0 66 10.5 2011 0 73 13.4 2011 0 72 10.9 2011 71 0 4.3 2011 0 59 10.3 2011 64 0 11.8 2011 66 0 11.2 2011 0 78 11.4 2011 0 68 8.6 2011 0 73 13.2 2011 62 0 12.6 2011 65 0 5.6 2011 68 0 9.9 2011 0 65 8.8 2011 60 0 7.7 2011 0 71 9.0 2011 65 0 7.3 2011 68 0 11.4 2011 64 0 13.6 2011 74 0 7.9 2011 69 0 10.7 2011 0 76 10.3 2011 68 0 8.3 2011 72 0 9.6 2011 67 0 14.2 2011 0 63 8.5 2011 0 59 13.5 2011 0 73 4.9 2011 0 66 6.4 2011 0 62 9.6 2011 0 69 11.6 2011 66 0 11.1 2011 51 0 4.35 2012 56 0 12.7 2012 67 0 18.1 2012 69 0 17.85 2012 0 57 16.6 2012 56 0 12.6 2012 55 0 17.1 2012 0 63 19.1 2012 67 0 16.1 2012 0 65 13.35 2012 0 47 18.4 2012 76 0 14.7 2012 64 0 10.6 2012 68 0 12.6 2012 64 0 16.2 2012 65 0 13.6 2012 71 0 18.9 2012 63 0 14.1 2012 60 0 14.5 2012 0 68 16.15 2012 72 0 14.75 2012 70 0 14.8 2012 61 0 12.45 2012 61 0 12.65 2012 62 0 17.35 2012 71 0 8.6 2012 0 71 18.4 2012 51 0 16.1 2012 56 0 11.6 2012 70 0 17.75 2012 73 0 15.25 2012 76 0 17.65 2012 0 59 15.6 2012 0 68 16.35 2012 0 48 17.65 2012 52 0 13.6 2012 0 59 11.7 2012 0 60 14.35 2012 0 59 14.75 2012 57 0 18.25 2012 0 79 9.9 2012 60 0 16 2012 60 0 18.25 2012 0 59 16.85 2012 62 0 14.6 2012 59 0 13.85 2012 61 0 18.95 2012 0 71 15.6 2012 0 57 14.85 2012 0 66 11.75 2012 0 63 18.45 2012 69 0 15.9 2012 0 58 17.1 2012 59 0 16.1 2012 0 48 19.9 2012 66 0 10.95 2012 0 73 18.45 2012 67 0 15.1 2012 0 61 15 2012 0 68 11.35 2012 75 0 15.95 2012 0 62 18.1 2012 69 0 14.6 2012 58 0 15.4 2012 60 0 15.4 2012 74 0 17.6 2012 55 0 13.35 2012 0 62 19.1 2012 63 0 15.35 2012 0 69 7.6 2012 0 58 13.4 2012 0 58 13.9 2012 68 0 19.1 2012 0 72 15.25 2012 62 0 12.9 2012 0 62 16.1 2012 0 65 17.35 2012 0 69 13.15 2012 0 66 12.15 2012 72 0 12.6 2012 62 0 10.35 2012 75 0 15.4 2012 58 0 9.6 2012 0 66 18.2 2012 0 55 13.6 2012 47 0 14.85 2012 0 72 14.75 2012 0 62 14.1 2012 0 64 14.9 2012 0 64 16.25 2012 19 0 19.25 2012 50 0 13.6 2012 0 68 13.6 2012 0 70 15.65 2012 79 0 12.75 2012 0 69 14.6 2012 71 0 9.85 2012 48 0 12.65 2012 66 0 11.9 2012 0 73 19.2 2012 74 0 16.6 2012 66 0 11.2 2012 71 0 15.25 2012 0 74 11.9 2012 0 78 13.2 2012 0 75 16.35 2012 53 0 12.4 2012 60 0 15.85 2012 0 50 14.35 2012 70 0 18.15 2012 69 0 11.15 2012 0 65 15.65 2012 0 78 17.75 2012 0 78 7.65 2012 59 0 12.35 2012 72 0 15.6 2012 0 70 19.3 2012 0 63 15.2 2012 0 63 17.1 2012 71 0 15.6 2012 74 0 18.4 2012 0 67 19.05 2012 0 66 18.55 2012 0 62 19.1 2012 80 0 13.1 2012 73 0 12.85 2012 67 0 9.5 2012 61 0 4.5 2012 0 73 11.85 2012 74 0 13.6 2012 32 0 11.7 2012 69 0 12.4 2012 0 69 13.35 2012 0 84 11.4 2012 64 0 14.9 2012 0 58 19.9 2012 60 0 17.75 2012 59 0 11.2 2012 78 0 14.6 2012 0 57 17.6 2012 60 0 14.05 2012 0 68 16.1 2012 68 0 13.35 2012 73 0 11.85 2012 0 69 11.95 2012 67 0 14.75 2012 0 60 15.15 2012 65 0 13.2 2012 0 66 16.85 2012 74 0 7.85 2012 0 81 7.7 2012 0 72 12.6 2012 55 0 7.85 2012 49 0 10.95 2012 0 74 12.35 2012 53 0 9.95 2012 64 0 14.9 2012 0 65 16.65 2012 57 0 13.4 2012 0 51 13.95 2012 0 80 15.7 2012 67 0 16.85 2012 70 0 10.95 2012 0 74 15.35 2012 75 0 12.2 2012 0 70 15.1 2012 0 69 17.75 2012 65 0 15.2 2012 0 55 14.6 2012 0 71 16.65 2012 65 0 8.1 2012
Names of X columns:
AMS.E_M AMS.E_F TOT Year
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
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