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