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