Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
13 12 26 50 4 12.9 8 8 57 62 4 12.2 14 11 37 54 5 12.8 16 13 67 71 4 7.4 14 11 43 54 4 6.7 13 10 52 65 9 12.6 15 7 52 73 8 14.8 13 10 43 52 11 13.3 20 15 84 84 4 11.1 17 12 67 42 4 8.2 15 12 49 66 6 11.4 16 10 70 65 4 6.4 12 10 52 78 8 10.6 17 14 58 73 4 12 11 6 68 75 4 6.3 16 12 62 72 11 11.3 16 14 43 66 4 11.9 15 11 56 70 4 9.3 13 8 56 61 6 9.6 14 12 74 81 6 10 19 15 65 71 4 6.4 16 13 63 69 8 13.8 17 11 58 71 5 10.8 10 12 57 72 4 13.8 15 7 63 68 9 11.7 14 11 53 70 4 10.9 14 7 57 68 7 16.1 16 12 51 61 10 13.4 15 12 64 67 4 9.9 17 13 53 76 4 11.5 14 9 29 70 7 8.3 16 11 54 60 12 11.7 15 12 58 72 7 9 16 15 43 69 5 9.7 16 12 51 71 8 10.8 10 6 53 62 5 10.3 8 5 54 70 4 10.4 17 13 56 64 9 12.7 14 11 61 58 7 9.3 10 6 47 76 4 11.8 14 12 39 52 4 5.9 12 10 48 59 4 11.4 16 6 50 68 4 13 16 12 35 76 4 10.8 16 11 30 65 7 12.3 8 6 68 67 4 11.3 16 12 49 59 7 11.8 15 12 61 69 4 7.9 8 8 67 76 4 12.7 13 10 47 63 4 12.3 14 11 56 75 4 11.6 13 7 50 63 8 6.7 16 12 43 60 4 10.9 19 13 67 73 4 12.1 19 14 62 63 4 13.3 14 12 57 70 4 10.1 15 6 41 75 7 5.7 13 14 54 66 12 14.3 10 10 45 63 4 8 16 12 48 63 4 13.3 15 11 61 64 4 9.3 11 10 56 70 5 12.5 9 7 41 75 15 7.6 16 12 43 61 5 15.9 12 7 53 60 10 9.2 12 12 44 62 9 9.1 14 12 66 73 8 11.1 14 10 58 61 4 13 13 10 46 66 5 14.5 15 12 37 64 4 12.2 17 12 51 59 9 12.3 14 12 51 64 4 11.4 11 8 56 60 10 8.8 9 10 66 56 4 14.6 7 5 37 78 4 12.6 13 10 59 53 6 NA 15 10 42 67 7 13 12 12 38 59 5 12.6 15 11 66 66 4 13.2 14 9 34 68 4 9.9 16 12 53 71 4 7.7 14 11 49 66 4 10.5 13 10 55 73 4 13.4 16 12 49 72 4 10.9 13 10 59 71 6 4.3 16 9 40 59 10 10.3 16 11 58 64 7 11.8 16 12 60 66 4 11.2 10 7 63 78 4 11.4 12 11 56 68 7 8.6 12 12 54 73 4 13.2 12 6 52 62 8 12.6 12 9 34 65 11 5.6 19 15 69 68 6 9.9 14 10 32 65 14 8.8 13 11 48 60 5 7.7 16 12 67 71 4 9 15 12 58 65 8 7.3 12 12 57 68 9 11.4 8 11 42 64 4 13.6 10 9 64 74 4 7.9 16 11 58 69 5 10.7 16 12 66 76 4 10.3 10 12 26 68 5 8.3 18 14 61 72 4 9.6 12 8 52 67 4 14.2 16 10 51 63 7 8.5 10 9 55 59 10 13.5 14 10 50 73 4 4.9 12 9 60 66 5 6.4 11 10 56 62 4 9.6 15 12 63 69 4 11.6 7 11 61 66 4 11.1 16 9 52 51 6 4.35 16 11 16 56 4 12.7 16 12 46 67 8 18.1 16 12 56 69 5 17.85 12 7 52 57 4 16.6 15 12 55 56 17 12.6 14 12 50 55 4 17.1 15 12 59 63 4 19.1 16 10 60 67 8 16.1 13 15 52 65 4 13.35 10 10 44 47 7 18.4 17 15 67 76 4 14.7 15 10 52 64 4 10.6 18 15 55 68 5 12.6 16 9 37 64 7 16.2 20 15 54 65 4 13.6 16 12 72 71 4 18.9 17 13 51 63 7 14.1 16 12 48 60 11 14.5 15 12 60 68 7 16.15 13 8 50 72 4 14.75 16 9 63 70 4 14.8 16 15 33 61 4 12.45 16 12 67 61 4 12.65 17 12 46 62 4 17.35 20 15 54 71 4 8.6 14 11 59 71 6 18.4 17 12 61 51 8 16.1 6 6 33 56 23 11.6 16 14 47 70 4 17.75 15 12 69 73 8 15.25 16 12 52 76 6 17.65 16 12 55 68 4 16.35 14 11 41 48 7 17.65 16 12 73 52 4 13.6 16 12 52 60 4 14.35 16 12 50 59 4 14.75 14 12 51 57 10 18.25 14 8 60 79 6 9.9 16 8 56 60 5 16 16 12 56 60 5 18.25 15 12 29 59 4 16.85 16 11 66 62 4 14.6 16 10 66 59 5 13.85 18 11 73 61 5 18.95 15 12 55 71 5 15.6 16 13 64 57 5 14.85 16 12 40 66 4 11.75 16 12 46 63 6 18.45 17 10 58 69 4 15.9 14 10 43 58 4 17.1 18 11 61 59 4 16.1 9 8 51 48 9 19.9 15 12 50 66 18 10.95 14 9 52 73 6 18.45 15 12 54 67 5 15.1 13 9 66 61 4 15 16 11 61 68 11 11.35 20 15 80 75 4 15.95 14 8 51 62 10 18.1 12 8 56 69 6 14.6 15 11 56 58 8 15.4 15 11 56 60 8 15.4 15 11 53 74 6 17.6 16 13 47 55 8 13.35 11 7 25 62 4 19.1 16 12 47 63 4 15.35 7 8 46 69 9 7.6 11 8 50 58 9 13.4 9 4 39 58 5 13.9 15 11 51 68 4 19.1 16 10 58 72 4 15.25 14 7 35 62 15 12.9 15 12 58 62 10 16.1 13 11 60 65 9 17.35 13 9 62 69 7 13.15 12 10 63 66 9 12.15 16 8 53 72 6 12.6 14 8 46 62 4 10.35 16 11 67 75 7 15.4 14 12 59 58 4 9.6 15 10 64 66 7 18.2 10 10 38 55 4 13.6 16 12 50 47 15 14.85 14 8 48 72 4 14.75 16 11 48 62 9 14.1 12 8 47 64 4 14.9 16 10 66 64 4 16.25 16 14 47 19 28 19.25 15 9 63 50 4 13.6 14 9 58 68 4 13.6 16 10 44 70 4 15.65 11 13 51 79 5 12.75 15 12 43 69 4 14.6 18 13 55 71 4 9.85 13 8 38 48 12 12.65 7 3 45 73 4 19.2 7 8 50 74 6 16.6 17 12 54 66 6 11.2 18 11 57 71 5 15.25 15 9 60 74 4 11.9 8 12 55 78 4 13.2 13 12 56 75 4 16.35 13 12 49 53 10 12.4 15 10 37 60 7 15.85 18 13 59 70 4 18.15 16 9 46 69 7 11.15 14 12 51 65 4 15.65 15 11 58 78 4 17.75 19 14 64 78 12 7.65 16 11 53 59 5 12.35 12 9 48 72 8 15.6 16 12 51 70 6 19.3 11 8 47 63 17 15.2 16 15 59 63 4 17.1 15 12 62 71 5 15.6 19 14 62 74 4 18.4 15 12 51 67 5 19.05 14 9 64 66 5 18.55 14 9 52 62 6 19.1 17 13 67 80 4 13.1 16 13 50 73 4 12.85 20 15 54 67 4 9.5 16 11 58 61 6 4.5 9 7 56 73 8 11.85 13 10 63 74 10 13.6 15 11 31 32 4 11.7 19 14 65 69 5 12.4 16 14 71 69 4 13.35 17 13 50 84 4 11.4 16 12 57 64 4 14.9 9 8 47 58 16 19.9 11 13 47 59 7 11.2 14 9 57 78 4 14.6 19 12 43 57 4 17.6 13 13 41 60 14 14.05 14 11 63 68 5 16.1 15 11 63 68 5 13.35 15 13 56 73 5 11.85 14 12 51 69 5 11.95 16 12 50 67 7 14.75 17 10 22 60 19 15.15 12 9 41 65 16 13.2 15 10 59 66 4 16.85 17 13 56 74 4 7.85 15 13 66 81 7 7.7 10 9 53 72 9 12.6 16 11 42 55 5 7.85 15 12 52 49 14 10.95 11 8 54 74 4 12.35 16 12 44 53 16 9.95 16 12 62 64 10 14.9 16 12 53 65 5 16.65 14 9 50 57 6 13.4 14 12 36 51 4 13.95 16 12 76 80 4 15.7 16 11 66 67 4 16.85 18 12 62 70 5 10.95 14 6 59 74 4 15.35 20 7 47 75 4 12.2 15 10 55 70 5 15.1 16 12 58 69 4 17.75 16 10 60 65 4 15.2 16 12 44 55 5 14.6 12 9 57 71 8 16.65 8 3 45 65 15 8.1
Names of X columns:
CONFSTATTOT CONFSOFTTOT AMS.I AMS.E AMS.A TOT
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
2
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
Pearson Chi-Squared
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