Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
30 112285 145 56 94 28 84786 101 56 103 38 83123 98 54 93 30 101193 132 89 103 22 38361 60 40 51 26 68504 38 25 70 25 119182 144 92 91 18 22807 5 18 22 11 17140 28 63 38 26 116174 84 44 93 25 57635 79 33 60 38 66198 127 84 123 44 71701 78 88 148 30 57793 60 55 90 40 80444 131 60 124 34 53855 84 66 70 47 97668 133 154 168 30 133824 150 53 115 31 101481 91 119 71 23 99645 132 41 66 36 114789 136 61 134 36 99052 124 58 117 30 67654 118 75 108 25 65553 70 33 84 39 97500 107 40 156 34 69112 119 92 120 31 82753 89 100 114 31 85323 112 112 94 33 72654 108 73 120 25 30727 52 40 81 33 77873 112 45 110 35 117478 116 60 133 42 74007 123 62 122 43 90183 125 75 158 30 61542 27 31 109 33 101494 162 77 124 13 27570 32 34 39 32 55813 64 46 92 36 79215 92 99 126 0 1423 0 17 0 28 55461 83 66 70 14 31081 41 30 37 17 22996 47 76 38 32 83122 120 146 120 30 70106 105 67 93 35 60578 79 56 95 20 39992 65 107 77 28 79892 70 58 90 28 49810 55 34 80 39 71570 39 61 31 34 100708 67 119 110 26 33032 21 42 66 39 82875 127 66 138 39 139077 152 89 133 33 71595 113 44 113 28 72260 99 66 100 4 5950 7 24 7 39 115762 141 259 140 18 32551 21 17 61 14 31701 35 64 41 29 80670 109 41 96 44 143558 133 68 164 21 117105 123 168 78 16 23789 26 43 49 28 120733 230 132 102 35 105195 166 105 124 28 73107 68 71 99 38 132068 147 112 129 23 149193 179 94 62 36 46821 61 82 73 32 87011 101 70 114 29 95260 108 57 99 25 55183 90 53 70 27 106671 114 103 104 36 73511 103 121 116 28 92945 142 62 91 23 78664 79 52 74 40 70054 88 52 138 23 22618 25 32 67 40 74011 83 62 151 28 83737 113 45 72 34 69094 118 46 120 33 93133 110 63 115 28 95536 129 75 105 34 225920 51 88 104 30 62133 93 46 108 33 61370 76 53 98 22 43836 49 37 69 38 106117 118 90 111 26 38692 38 63 99 35 84651 141 78 71 8 56622 58 25 27 24 15986 27 45 69 29 95364 91 46 107 20 26706 48 41 73 29 89691 63 144 107 45 67267 56 82 93 37 126846 144 91 129 33 41140 73 71 69 33 102860 168 63 118 25 51715 64 53 73 32 55801 97 62 119 29 111813 117 63 104 28 120293 100 32 107 28 138599 149 39 99 31 161647 187 62 90 52 115929 127 117 197 21 24266 37 34 36 24 162901 245 92 85 41 109825 87 93 139 33 129838 177 54 106 32 37510 49 144 50 19 43750 49 14 64 20 40652 73 61 31 31 87771 177 109 63 31 85872 94 38 92 32 89275 117 73 106 18 44418 60 75 63 23 192565 55 50 69 17 35232 39 61 41 20 40909 64 55 56 12 13294 26 77 25 17 32387 64 75 65 30 140867 58 72 93 31 120662 95 50 114 10 21233 25 32 38 13 44332 26 53 44 22 61056 76 42 87 42 101338 129 71 110 1 1168 11 10 0 9 13497 2 35 27 32 65567 101 65 83 11 25162 28 25 30 25 32334 36 66 80 36 40735 89 41 98 31 91413 193 86 82 0 855 4 16 0 24 97068 84 42 60 13 44339 23 19 28 8 14116 39 19 9 13 10288 14 45 33 19 65622 78 65 59 18 16563 14 35 49 33 76643 101 95 115 40 110681 82 49 140 22 29011 24 37 49 38 92696 36 64 120 24 94785 75 38 66 8 8773 16 34 21 35 83209 55 32 124 43 93815 131 65 152 43 86687 131 52 139 14 34553 39 62 38 41 105547 144 65 144 38 103487 139 83 120 45 213688 211 95 160 31 71220 78 29 114 13 23517 50 18 39 28 56926 39 33 78 31 91721 90 247 119 40 115168 166 139 141 30 111194 12 29 101 16 51009 57 118 56 37 135777 133 110 133 30 51513 69 67 83 35 74163 119 42 116 32 51633 119 65 90 27 75345 65 94 36 20 33416 61 64 50 18 83305 49 81 61 31 98952 101 95 97 31 102372 196 67 98 21 37238 15 63 78 39 103772 136 83 117 41 123969 89 45 148 13 27142 40 30 41 32 135400 123 70 105 18 21399 21 32 55 39 130115 163 83 132 14 24874 29 31 44 7 34988 35 67 21 17 45549 13 66 50 0 6023 5 10 0 30 64466 96 70 73 37 54990 151 103 86 0 1644 6 5 0 5 6179 13 20 13 1 3926 3 5 4 16 32755 56 36 57 32 34777 23 34 48 24 73224 57 48 46 17 27114 14 40 48 11 20760 43 43 32 24 37636 20 31 68 22 65461 72 42 87 12 30080 87 46 43 19 24094 21 33 67 13 69008 56 18 46 17 54968 59 55 46 15 46090 82 35 56 16 27507 43 59 48 24 10672 25 19 44 15 34029 38 66 60 17 46300 25 60 65 18 24760 38 36 55 20 18779 12 25 38 16 21280 29 47 52 16 40662 47 54 60 18 28987 45 53 54 22 22827 40 40 86 8 18513 30 40 24 17 30594 41 39 52 18 24006 25 14 49 16 27913 23 45 61 23 42744 14 36 61 22 12934 16 28 81 13 22574 26 44 43 13 41385 21 30 40 16 18653 27 22 40 16 18472 9 17 56 20 30976 33 31 68 22 63339 42 55 79 17 25568 68 54 47 18 33747 32 21 57 17 4154 6 14 41 12 19474 67 81 29 7 35130 33 35 3 17 39067 77 43 60 14 13310 46 46 30 23 65892 30 30 79 17 4143 0 23 47 14 28579 36 38 40 15 51776 46 54 48 17 21152 18 20 36 21 38084 48 53 42 18 27717 29 45 49 18 32928 28 39 57 17 11342 34 20 12 17 19499 33 24 40 16 16380 34 31 43 15 36874 33 35 33 21 48259 80 151 77 16 16734 32 52 43 14 28207 30 30 45 15 30143 41 31 47 17 41369 41 29 43 15 45833 51 57 45 15 29156 18 40 50 10 35944 34 44 35 6 36278 31 25 7 22 45588 39 77 71 21 45097 54 35 67 1 3895 14 11 0 18 28394 24 63 62 17 18632 24 44 54 4 2325 8 19 4 10 25139 26 13 25 16 27975 19 42 40 16 14483 11 38 38 9 13127 14 29 19 16 5839 1 20 17 17 24069 39 27 67 7 3738 5 20 14 15 18625 37 19 30 14 36341 32 37 54 14 24548 38 26 35 18 21792 47 42 59 12 26263 47 49 24 16 23686 37 30 58 21 49303 51 49 42 19 25659 45 67 46 16 28904 21 28 61 1 2781 1 19 3 16 29236 42 49 52 10 19546 26 27 25 19 22818 21 30 40 12 32689 4 22 32 2 5752 10 12 4 14 22197 43 31 49 17 20055 34 20 63 19 25272 31 20 67 14 82206 19 39 32 11 32073 34 29 23 4 5444 6 16 7 16 20154 11 27 54 20 36944 24 21 37 12 8019 16 19 35 15 30884 72 35 51 16 19540 21 14 39
Names of X columns:
compendiums_reviewed totsize totblogs logins feedback_messages
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