Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
0 26 13 13 13 96 13.125 12.9 1 57 8 13 16 70 13.75 12.2 0 37 14 11 11 88 13.75 12.8 1 67 16 14 10 114 11.25 7.4 1 43 14 15 9 69 14.375 6.7 1 52 13 14 8 176 7.5 12.6 0 52 15 11 26 114 12.5 14.8 1 43 13 13 10 121 13.75 13.3 1 84 20 16 10 110 13.125 11.1 1 67 17 14 8 158 11.875 8.2 1 49 15 14 13 116 13.75 11.4 1 70 16 15 11 181 9.375 6.4 1 52 12 15 8 77 12.5 10.6 0 58 17 13 12 141 11.875 12.0 0 68 11 14 24 35 11.25 6.3 0 62 16 11 21 80 9.375 11.3 1 43 16 12 5 152 12.5 11.9 0 56 15 14 14 97 13.125 9.3 1 56 13 13 11 99 13.125 9.6 0 74 14 12 9 84 9.375 10.0 1 63 16 15 17 101 14.375 13.8 0 58 17 14 18 107 13.125 10.8 1 63 15 12 23 112 15.625 11.7 1 53 14 12 9 171 5.625 10.9 1 57 14 12 14 137 18.75 16.1 0 51 16 15 13 77 12.5 13.4 1 64 15 14 10 66 14.375 9.9 0 53 17 16 8 93 10 11.5 0 29 14 12 10 105 10 8.3 0 54 16 12 19 131 11.875 11.7 1 58 15 14 11 102 15.625 9.0 1 43 16 16 16 161 11.25 9.7 1 51 16 15 12 120 14.375 10.8 1 53 10 12 11 127 13.125 10.3 0 54 8 14 11 77 6.25 10.4 1 56 17 13 10 108 8.75 12.7 1 61 14 14 13 85 13.75 9.3 0 47 10 16 14 168 16.25 11.8 1 39 14 12 8 48 14.375 5.9 1 48 12 14 11 152 14.375 11.4 1 50 16 15 11 75 15 13.0 1 35 16 13 13 107 15 10.8 1 30 16 16 15 62 11.25 12.3 0 68 8 16 15 121 14.375 11.3 1 49 16 12 16 124 9.375 11.8 1 61 15 12 12 72 11.875 7.9 0 67 8 16 12 40 10 12.7 1 47 13 12 17 58 15.625 12.3 1 56 14 15 14 97 14.375 11.6 1 50 13 12 15 88 10.625 6.7 1 43 16 13 12 126 11.875 10.9 1 67 19 12 13 104 13.125 12.1 1 62 19 14 7 148 11.25 13.3 1 57 14 14 8 146 16.875 10.1 0 41 15 11 16 80 13.125 5.7 1 54 13 10 20 97 8.125 14.3 0 45 10 12 14 25 5 8.0 1 48 16 11 10 99 18.125 13.3 1 61 15 16 16 118 17.5 9.3 0 56 11 14 11 58 14.375 12.5 0 41 9 14 26 63 13.125 7.6 1 43 16 15 9 139 11.875 15.9 0 53 12 15 15 50 11.875 9.2 1 44 12 14 12 60 12.5 9.1 0 66 14 13 21 152 11.25 11.1 1 58 14 11 20 142 11.875 13.0 1 46 13 16 20 94 10.625 14.5 0 37 15 12 10 66 11.875 12.2 0 51 17 15 15 127 15.625 12.3 0 51 14 14 10 67 11.875 11.4 1 66 9 14 9 75 14.375 14.6 0 37 7 13 17 128 8.75 12.6 1 59 13 6 10 41 17.5 NA 0 42 15 12 19 146 10 13.0 1 38 12 12 13 69 15 12.6 0 66 15 14 8 186 12.5 13.2 0 34 14 14 11 81 7.5 9.9 1 53 16 15 9 85 15 7.7 0 49 14 11 12 54 13.75 10.5 0 55 13 13 10 46 7.5 13.4 0 49 16 14 9 106 13.75 10.9 1 59 13 16 14 34 12.5 4.3 0 40 16 13 14 60 6.25 10.3 1 58 16 14 10 95 14.375 11.8 1 60 16 16 8 57 10.625 11.2 0 63 10 11 13 62 13.75 11.4 0 56 12 13 9 36 15 8.6 0 54 12 13 14 56 11.25 13.2 1 52 12 15 8 54 13.125 12.6 1 34 12 12 16 64 12.5 5.6 1 69 19 13 14 76 12.5 9.9 0 32 14 12 14 98 13.75 8.8 1 48 13 14 8 88 11.875 7.7 0 67 16 14 11 35 12.5 9.0 1 58 15 16 11 102 16.25 7.3 1 57 12 15 13 61 14.375 11.4 1 42 8 14 12 80 15 13.6 1 64 10 13 13 49 13.125 7.9 1 58 16 14 9 78 13.125 10.7 0 66 16 15 10 90 11.875 10.3 1 61 18 12 11 55 10.625 9.6 1 52 12 7 13 96 12.5 14.2 0 51 16 12 17 43 6.875 8.5 0 55 10 15 15 52 5 13.5 0 60 12 13 14 54 11.25 6.4 0 56 11 11 10 51 11.25 9.6 0 63 15 14 15 51 11.875 11.6 1 61 7 13 14 38 11.875 11.1
Names of X columns:
Gender AMS.I CONFSTATTOT STRESSTOT CESDTOT BEREK NUMTOT TOT
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 mywarning <- '' par1 <- as.numeric(par1) if(is.na(par1)) { par1 <- 1 mywarning = 'Warning: you did not specify the column number of the endogenous series! The first column was selected by default.' } 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.row.start(a) a<-table.element(a, mywarning) 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,formatC(signif(mysum$coefficients[i,1],5),format='g',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,2],5),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,3],4),format='e',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4],4),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4]/2,4),format='g',flag=' ')) 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,formatC(signif(sqrt(mysum$r.squared),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$adj.r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a,formatC(signif(mysum$fstatistic[1],6),format='g',flag=' ')) 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,formatC(signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6),format='g',flag=' ')) 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,formatC(signif(mysum$sigma,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a,formatC(signif(sum(myerror*myerror),6),format='g',flag=' ')) 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,formatC(signif(x[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(x[i]-mysum$resid[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$resid[i],6),format='g',flag=' ')) 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,formatC(signif(gqarr[mypoint-kp3+1,1],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,2],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,3],6),format='g',flag=' ')) 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,formatC(signif(numsignificant1/numgqtests,6),format='g',flag=' ')) 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