Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1 1 1 41 41 13 14 14 12 12 1 2 2 39 39 16 18 18 11 11 1 3 3 30 30 19 11 11 14 14 1 4 4 31 31 15 12 12 12 12 1 5 5 34 34 14 16 16 21 21 1 6 6 35 35 13 18 18 12 12 1 7 7 39 39 19 14 14 22 22 1 8 8 34 34 15 14 14 11 11 1 9 9 36 36 14 15 15 10 10 1 10 10 37 37 15 15 15 13 13 1 11 11 38 38 16 17 17 10 10 1 12 12 36 36 16 19 19 8 8 1 13 13 38 38 16 10 10 15 15 1 14 14 39 39 16 16 16 14 14 1 15 15 33 33 17 18 18 10 10 1 16 16 32 32 15 14 14 14 14 1 17 17 36 36 15 14 14 14 14 1 18 18 38 38 20 17 17 11 11 1 19 19 39 39 18 14 14 10 10 1 20 20 32 32 16 16 16 13 13 1 21 21 32 32 16 18 18 7 7 1 22 22 31 31 16 11 11 14 14 1 23 23 39 39 19 14 14 12 12 1 24 24 37 37 16 12 12 14 14 1 25 25 39 39 17 17 17 11 11 1 26 26 41 41 17 9 9 9 9 1 27 27 36 36 16 16 16 11 11 1 28 28 33 33 15 14 14 15 15 1 29 29 33 33 16 15 15 14 14 1 30 30 34 34 14 11 11 13 13 1 31 31 31 31 15 16 16 9 9 1 32 32 27 27 12 13 13 15 15 1 33 33 37 37 14 17 17 10 10 1 34 34 34 34 16 15 15 11 11 1 35 35 34 34 14 14 14 13 13 1 36 36 32 32 7 16 16 8 8 1 37 37 29 29 10 9 9 20 20 1 38 38 36 36 14 15 15 12 12 1 39 39 29 29 16 17 17 10 10 1 40 40 35 35 16 13 13 10 10 1 41 41 37 37 16 15 15 9 9 1 42 42 34 34 14 16 16 14 14 1 43 43 38 38 20 16 16 8 8 1 44 44 35 35 14 12 12 14 14 1 45 45 38 38 14 12 12 11 11 1 46 46 37 37 11 11 11 13 13 1 47 47 38 38 14 15 15 9 9 1 48 48 33 33 15 15 15 11 11 1 49 49 36 36 16 17 17 15 15 1 50 50 38 38 14 13 13 11 11 1 51 51 32 32 16 16 16 10 10 1 52 52 32 32 14 14 14 14 14 1 53 53 32 32 12 11 11 18 18 1 54 54 34 34 16 12 12 14 14 1 55 55 32 32 9 12 12 11 11 1 56 56 37 37 14 15 15 12 12 1 57 57 39 39 16 16 16 13 13 1 58 58 29 29 16 15 15 9 9 1 59 59 37 37 15 12 12 10 10 1 60 60 35 35 16 12 12 15 15 1 61 61 30 30 12 8 8 20 20 1 62 62 38 38 16 13 13 12 12 1 63 63 34 34 16 11 11 12 12 1 64 64 31 31 14 14 14 14 14 1 65 65 34 34 16 15 15 13 13 1 66 66 35 35 17 10 10 11 11 1 67 67 36 36 18 11 11 17 17 1 68 68 30 30 18 12 12 12 12 1 69 69 39 39 12 15 15 13 13 1 70 70 35 35 16 15 15 14 14 1 71 71 38 38 10 14 14 13 13 1 72 72 31 31 14 16 16 15 15 1 73 73 34 34 18 15 15 13 13 1 74 74 38 38 18 15 15 10 10 1 75 75 34 34 16 13 13 11 11 1 76 76 39 39 17 12 12 19 19 1 77 77 37 37 16 17 17 13 13 1 78 78 34 34 16 13 13 17 17 1 79 79 28 28 13 15 15 13 13 1 80 80 37 37 16 13 13 9 9 0 81 81 33 33 16 15 15 11 11 0 82 82 37 37 20 16 16 10 10 0 83 83 35 35 16 15 15 9 9 0 84 84 37 37 15 16 16 12 12 0 85 85 32 32 15 15 15 12 12 0 86 86 33 33 16 14 14 13 13 0 87 87 38 38 14 15 15 13 13 0 88 88 33 33 16 14 14 12 12 0 89 89 29 29 16 13 13 15 15 0 90 90 33 33 15 7 7 22 22 0 91 91 31 31 12 17 17 13 13 0 92 92 36 36 17 13 13 15 15 0 93 93 35 35 16 15 15 13 13 0 94 94 32 32 15 14 14 15 15 0 95 95 29 29 13 13 13 10 10 0 96 96 39 39 16 16 16 11 11 0 97 97 37 37 16 12 12 16 16 0 98 98 35 35 16 14 14 11 11 0 99 99 37 37 16 17 17 11 11 0 100 100 32 32 14 15 15 10 10 0 101 101 38 38 16 17 17 10 10 0 102 102 37 37 16 12 12 16 16 0 103 103 36 36 20 16 16 12 12 0 104 104 32 32 15 11 11 11 11 0 105 105 33 33 16 15 15 16 16 0 106 106 40 40 13 9 9 19 19 0 107 107 38 38 17 16 16 11 11 0 108 108 41 41 16 15 15 16 16 0 109 109 36 36 16 10 10 15 15 0 110 110 43 43 12 10 10 24 24 0 111 111 30 30 16 15 15 14 14 0 112 112 31 31 16 11 11 15 15 0 113 113 32 32 17 13 13 11 11 0 114 114 32 32 13 14 14 15 15 0 115 115 37 37 12 18 18 12 12 0 116 116 37 37 18 16 16 10 10 0 117 117 33 33 14 14 14 14 14 0 118 118 34 34 14 14 14 13 13 0 119 119 33 33 13 14 14 9 9 0 120 120 38 38 16 14 14 15 15 0 121 121 33 33 13 12 12 15 15 0 122 122 31 31 16 14 14 14 14 0 123 123 38 38 13 15 15 11 11 0 124 124 37 37 16 15 15 8 8 0 125 125 33 33 15 15 15 11 11 0 126 126 31 31 16 13 13 11 11 0 127 127 39 39 15 17 17 8 8 0 128 128 44 44 17 17 17 10 10 0 129 129 33 33 15 19 19 11 11 0 130 130 35 35 12 15 15 13 13 0 131 131 32 32 16 13 13 11 11 0 132 132 28 28 10 9 9 20 20 0 133 133 40 40 16 15 15 10 10 0 134 134 27 27 12 15 15 15 15 0 135 135 37 37 14 15 15 12 12 0 136 136 32 32 15 16 16 14 14 0 137 137 28 28 13 11 11 23 23 0 138 138 34 34 15 14 14 14 14 0 139 139 30 30 11 11 11 16 16 0 140 140 35 35 12 15 15 11 11 0 141 141 31 31 8 13 13 12 12 0 142 142 32 32 16 15 15 10 10 0 143 143 30 30 15 16 16 14 14 0 144 144 30 30 17 14 14 12 12 0 145 145 31 31 16 15 15 12 12 0 146 146 40 40 10 16 16 11 11 0 147 147 32 32 18 16 16 12 12 0 148 148 36 36 13 11 11 13 13 0 149 149 32 32 16 12 12 11 11 0 150 150 35 35 13 9 9 19 19 0 151 151 38 38 10 16 16 12 12 0 152 152 42 42 15 13 13 17 17 0 153 153 34 34 16 16 16 9 9 0 154 154 35 35 16 12 12 12 12 0 155 155 35 35 14 9 9 19 19 0 156 156 33 33 10 13 13 18 18 0 157 157 36 36 17 13 13 15 15 0 158 158 32 32 13 14 14 14 14 0 159 159 33 33 15 19 19 11 11 0 160 160 34 34 16 13 13 9 9 0 161 161 32 32 12 12 12 18 18 0 162 162 34 34 13 13 13 16 16
Names of X columns:
Pop t Pop_t connected connected_p learning happiness happiness_p depression depression_p
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, 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