Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
9 26 21 21 23 17 23 4 14 12 127 9 20 16 15 24 17 20 4 18 11 108 9 19 19 18 22 18 20 6 11 14 110 9 19 18 11 20 21 21 8 12 12 102 9 20 16 8 24 20 24 8 16 21 104 9 25 23 19 27 28 22 4 18 12 140 9 25 17 4 28 19 23 4 14 22 112 9 22 12 20 27 22 20 8 14 11 115 9 26 19 16 24 16 25 5 15 10 121 9 22 16 14 23 18 23 4 15 13 112 9 17 19 10 24 25 27 4 17 10 118 9 22 20 13 27 17 27 4 19 8 122 9 19 13 14 27 14 22 4 10 15 105 9 24 20 8 28 11 24 4 16 14 111 9 26 27 23 27 27 25 4 18 10 151 9 21 17 11 23 20 22 8 14 14 106 9 13 8 9 24 22 28 4 14 14 100 9 26 25 24 28 22 28 4 17 11 149 9 20 26 5 27 21 27 4 14 10 122 9 22 13 15 25 23 25 8 16 13 115 9 14 19 5 19 17 16 4 18 7 86 9 21 15 19 24 24 28 7 11 14 124 9 7 5 6 20 14 21 4 14 12 69 9 23 16 13 28 17 24 4 12 14 117 9 17 14 11 26 23 27 5 17 11 113 9 25 24 17 23 24 14 4 9 9 123 9 25 24 17 23 24 14 4 16 11 123 9 19 9 5 20 8 27 4 14 15 84 9 20 19 9 11 22 20 4 15 14 97 9 23 19 15 24 23 21 4 11 13 121 9 22 25 17 25 25 22 4 16 9 132 9 22 19 17 23 21 21 4 13 15 119 9 21 18 20 18 24 12 15 17 10 98 9 15 15 12 20 15 20 10 15 11 87 9 20 12 7 20 22 24 4 14 13 101 9 22 21 16 24 21 19 8 16 8 115 9 18 12 7 23 25 28 4 9 20 109 9 20 15 14 25 16 23 4 15 12 109 9 28 28 24 28 28 27 4 17 10 159 9 22 25 15 26 23 22 4 13 10 129 9 18 19 15 26 21 27 7 15 9 119 9 23 20 10 23 21 26 4 16 14 119 9 20 24 14 22 26 22 6 16 8 122 9 25 26 18 24 22 21 5 12 14 131 9 26 25 12 21 21 19 4 12 11 120 9 15 12 9 20 18 24 16 11 13 82 9 17 12 9 22 12 19 5 15 9 86 9 23 15 8 20 25 26 12 15 11 105 9 21 17 18 25 17 22 6 17 15 114 9 13 14 10 20 24 28 9 13 11 100 9 18 16 17 22 15 21 9 16 10 100 9 19 11 14 23 13 23 4 14 14 99 9 22 20 16 25 26 28 5 11 18 132 9 16 11 10 23 16 10 4 12 14 82 9 24 22 19 23 24 24 4 12 11 132 9 18 20 10 22 21 21 5 15 12 107 9 20 19 14 24 20 21 4 16 13 114 9 24 17 10 25 14 24 4 15 9 110 9 14 21 4 21 25 24 4 12 10 105 9 22 23 19 12 25 25 5 12 15 121 9 24 18 9 17 20 25 4 8 20 109 9 18 17 12 20 22 23 6 13 12 106 9 21 27 16 23 20 21 4 11 12 124 9 23 25 11 23 26 16 4 14 14 120 9 17 19 18 20 18 17 18 15 13 91 10 22 22 11 28 22 25 4 10 11 126 10 24 24 24 24 24 24 6 11 17 138 10 21 20 17 24 17 23 4 12 12 118 10 22 19 18 24 24 25 4 15 13 128 10 16 11 9 24 20 23 5 15 14 98 10 21 22 19 28 19 28 4 14 13 133 10 23 22 18 25 20 26 4 16 15 130 10 22 16 12 21 15 22 5 15 13 103 10 24 20 23 25 23 19 10 15 10 124 10 24 24 22 25 26 26 5 13 11 142 10 16 16 14 18 22 18 8 12 19 96 10 16 16 14 17 20 18 8 17 13 93 10 21 22 16 26 24 25 5 13 17 129 10 26 24 23 28 26 27 4 15 13 150 10 15 16 7 21 21 12 4 13 9 88 10 25 27 10 27 25 15 4 15 11 125 10 18 11 12 22 13 21 5 16 10 92 10 23 21 12 21 20 23 4 15 9 0 10 20 20 12 25 22 22 4 16 12 117 10 17 20 17 22 23 21 8 15 12 112 10 25 27 21 23 28 24 4 14 13 144 10 24 20 16 26 22 27 5 15 13 130 10 17 12 11 19 20 22 14 14 12 87 10 19 8 14 25 6 28 8 13 15 92 10 20 21 13 21 21 26 8 7 22 114 10 15 18 9 13 20 10 4 17 13 81 10 27 24 19 24 18 19 4 13 15 127 10 22 16 13 25 23 22 6 15 13 115 10 23 18 19 26 20 21 4 14 15 123 10 16 20 13 25 24 24 7 13 10 115 10 19 20 13 25 22 25 7 16 11 117 10 25 19 13 22 21 21 4 12 16 117 10 19 17 14 21 18 20 6 14 11 103 10 19 16 12 23 21 21 4 17 11 108 10 26 26 22 25 23 24 7 15 10 139 10 21 15 11 24 23 23 4 17 10 113 10 20 22 5 21 15 18 4 12 16 97 10 24 17 18 21 21 24 8 16 12 117 10 22 23 19 25 24 24 4 11 11 133 10 20 21 14 22 23 19 4 15 16 115 10 18 19 15 20 21 20 10 9 19 103 10 18 14 12 20 21 18 8 16 11 95 10 24 17 19 23 20 20 6 15 16 117 10 24 12 15 28 11 27 4 10 15 113 10 22 24 17 23 22 23 4 10 24 127 10 23 18 8 28 27 26 4 15 14 126 10 22 20 10 24 25 23 5 11 15 119 10 20 16 12 18 18 17 4 13 11 97 10 18 20 12 20 20 21 6 14 15 105 10 25 22 20 28 24 25 4 18 12 140 10 18 12 12 21 10 23 5 16 10 91 10 16 16 12 21 27 27 7 14 14 112 10 20 17 14 25 21 24 8 14 13 113 10 19 22 6 19 21 20 5 14 9 102 10 15 12 10 18 18 27 8 14 15 92 10 19 14 18 21 15 21 10 12 15 98 10 19 23 18 22 24 24 8 14 14 122 10 16 15 7 24 22 21 5 15 11 100 10 17 17 18 15 14 15 12 15 8 84 10 28 28 9 28 28 25 4 15 11 142 10 23 20 17 26 18 25 5 13 11 124 10 25 23 22 23 26 22 4 17 8 137 10 20 13 11 26 17 24 6 17 10 105 10 17 18 15 20 19 21 4 19 11 106 10 23 23 17 22 22 22 4 15 13 125 10 16 19 15 20 18 23 7 13 11 104 10 23 23 22 23 24 22 7 9 20 130 10 11 12 9 22 15 20 10 15 10 79 10 18 16 13 24 18 23 4 15 15 108 10 24 23 20 23 26 25 5 15 12 136 10 23 13 14 22 11 23 8 16 14 98 10 21 22 14 26 26 22 11 11 23 120 10 16 18 12 23 21 25 7 14 14 108 10 24 23 20 27 23 26 4 11 16 139 10 23 20 20 23 23 22 8 15 11 123 10 18 10 8 21 15 24 6 13 12 90 10 20 17 17 26 22 24 7 15 10 119 10 9 18 9 23 26 25 5 16 14 105 10 24 15 18 21 16 20 4 14 12 110 10 25 23 22 27 20 26 8 15 12 135 10 20 17 10 19 18 21 4 16 11 101 10 21 17 13 23 22 26 8 16 12 114 10 25 22 15 25 16 21 6 11 13 118 10 22 20 18 23 19 22 4 12 11 120 10 21 20 18 22 20 16 9 9 19 108 10 21 19 12 22 19 26 5 16 12 114 10 22 18 12 25 23 28 6 13 17 122 10 27 22 20 25 24 18 4 16 9 132 9 24 20 12 28 25 25 4 12 12 130 10 24 22 16 28 21 23 4 9 19 130 10 21 18 16 20 21 21 5 13 18 112 10 18 16 18 25 23 20 6 13 15 114 10 16 16 16 19 27 25 16 14 14 103 10 22 16 13 25 23 22 6 19 11 115 10 20 16 17 22 18 21 6 13 9 108 10 18 17 13 18 16 16 4 12 18 94 11 20 18 17 20 16 18 4 13 16 105
Names of X columns:
Month I1 I2 I3 E1 E2 E3 A Happiness Depression Motivation
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
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, mysum$coefficients[i,1], 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,mysum$coefficients[i,1]) a<-table.element(a, round(mysum$coefficients[i,2],6)) a<-table.element(a, round(mysum$coefficients[i,3],4)) a<-table.element(a, round(mysum$coefficients[i,4],6)) a<-table.element(a, round(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, sqrt(mysum$r.squared)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a, mysum$r.squared) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a, mysum$adj.r.squared) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a, mysum$fstatistic[1]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, mysum$fstatistic[2]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, mysum$fstatistic[3]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a, 1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3])) 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, mysum$sigma) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a, sum(myerror*myerror)) 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,x[i]) a<-table.element(a,x[i]-mysum$resid[i]) a<-table.element(a,mysum$resid[i]) 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,gqarr[mypoint-kp3+1,1]) a<-table.element(a,gqarr[mypoint-kp3+1,2]) a<-table.element(a,gqarr[mypoint-kp3+1,3]) 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,numsignificant1) a<-table.element(a,numsignificant1/numgqtests) 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,numsignificant5) a<-table.element(a,numsignificant5/numgqtests) 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,numsignificant10) a<-table.element(a,numsignificant10/numgqtests) 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