Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
279055 1818 73 96 42 130 186099 212408 1433 75 75 38 143 113854 233939 2059 83 70 46 118 99776 222117 2733 106 134 42 146 106194 189911 1399 56 83 30 73 100792 70849 631 28 8 35 89 47552 605767 5460 135 173 40 146 250931 33186 381 19 1 18 22 6853 227332 2150 62 88 38 132 115466 267925 2042 49 104 37 92 110896 371987 2536 122 114 46 147 169351 264989 2377 131 125 60 203 94853 212638 2100 87 57 37 113 72591 368577 3020 85 139 55 171 101345 269455 2265 88 87 44 87 113713 398124 5139 191 176 63 208 165354 335567 2363 77 114 40 153 164263 428322 3548 172 121 43 97 135213 182016 1477 58 103 32 95 111669 267365 2398 89 135 52 197 134163 279428 2546 73 123 49 160 140303 508849 3150 111 99 41 148 150773 217270 1694 48 77 25 84 111848 200004 1787 58 103 57 227 102509 257139 3792 133 158 45 154 96785 270941 3108 138 116 42 151 116136 324969 3230 134 114 45 142 158376 329962 2348 92 150 43 148 153990 190867 1780 60 64 36 110 64057 393860 3218 79 150 45 149 230054 327660 2692 89 143 50 179 184531 269239 2187 83 50 50 149 114198 396136 2577 106 145 51 187 198299 130446 1293 49 56 42 153 33750 430118 3567 104 141 44 163 189723 273950 2764 56 83 42 127 100826 428077 3755 128 112 44 151 188355 254312 2075 93 79 40 100 104470 120351 995 35 33 17 46 58391 395658 3750 212 152 43 156 164808 345875 3413 86 126 41 128 134097 216827 2053 82 97 41 111 80238 224524 1984 83 84 40 119 133252 182485 1825 69 68 49 148 54518 157164 2599 85 50 52 65 121850 459455 5572 157 101 42 134 79367 78800 918 42 20 26 66 56968 255072 2685 85 107 59 201 106314 368086 4145 123 150 50 177 191889 230299 2841 70 129 50 156 104864 244782 2175 81 99 47 158 160792 24188 496 24 8 4 7 15049 400109 2699 334 88 51 175 191179 65029 744 17 21 18 61 25109 101097 1161 64 30 14 41 45824 309810 3333 67 102 41 133 129711 375638 2970 91 166 61 228 210012 367127 3968 204 132 40 140 194679 381998 2878 155 161 44 155 197680 280106 2399 90 90 40 141 81180 400971 4121 153 160 51 181 197765 315924 3294 122 139 29 75 214738 291391 3132 124 104 43 97 96252 295075 2868 93 103 42 142 124527 280018 1778 81 66 41 136 153242 267432 2109 71 163 30 87 145707 217181 2148 141 93 39 140 113963 258166 3009 159 85 51 169 134904 264771 2562 88 154 40 129 114268 182961 1737 73 143 29 92 94333 256967 2680 74 107 47 160 102204 73566 893 32 22 23 67 23824 272362 2389 93 85 48 179 111563 229056 2197 62 101 38 90 91313 229851 2227 70 131 42 144 89770 371391 2370 91 140 46 144 100125 398210 3226 104 156 40 144 165278 220419 1978 111 81 45 134 181712 231884 2516 72 137 42 146 80906 219381 2147 73 102 41 121 75881 206169 2150 54 74 37 112 83963 483074 4228 131 161 47 145 175721 146100 1380 72 30 26 99 68580 295224 2449 109 120 48 96 136323 80953 870 25 49 8 27 55792 217384 2700 63 121 27 77 25157 179344 1574 62 76 38 137 100922 415550 4046 222 85 41 151 118845 389059 3259 129 151 61 126 170492 180679 3098 106 165 45 159 81716 299505 2615 104 89 41 101 115750 292260 2404 84 168 42 144 105590 199481 1932 68 48 35 102 92795 282361 3147 78 149 36 135 82390 329281 2598 89 75 40 147 135599 234577 2108 48 107 40 155 127667 297995 2193 67 116 38 138 163073 342490 2478 90 181 43 113 211381 416463 4198 163 155 65 248 189944 415683 4069 119 165 33 116 226168 297080 2842 142 121 51 176 117495 331792 2562 71 176 45 140 195894 229772 2449 202 86 36 59 80684 43287 602 14 13 19 64 19630 238089 2579 87 120 25 40 88634 263322 2591 160 117 44 98 139292 302082 2957 61 133 45 139 128602 321797 2786 95 169 44 135 135848 193926 1477 96 39 35 97 178377 175138 3350 105 125 46 142 106330 354041 2107 78 82 44 155 178303 303273 2332 91 148 45 115 116938 23668 400 13 12 1 0 5841 196743 2233 79 146 40 103 106020 61857 530 25 23 11 30 24610 217543 2033 54 87 51 130 74151 440711 3246 128 164 38 102 232241 21054 387 16 4 0 0 6622 252805 2137 52 81 30 77 127097 31961 492 22 18 8 9 13155 360436 3838 125 118 43 150 160501 251948 2193 77 76 48 163 91502 187320 1796 97 55 49 148 24469 180842 1907 58 62 32 94 88229 38214 568 34 16 8 21 13983 280392 2602 56 98 43 151 80716 358276 2819 84 137 52 187 157384 211775 1464 67 50 53 171 122975 447335 3946 90 152 49 170 191469 348017 2554 99 163 48 145 231257 441946 3506 133 142 56 198 258287 215177 1552 43 80 45 152 122531 130177 1389 47 59 40 112 61394 318037 3101 365 94 48 173 86480 466139 4541 198 128 50 177 195791 162279 1872 62 63 43 153 18284 416643 4403 140 127 46 161 147581 178322 2113 86 60 40 115 72558 292443 2046 54 118 45 147 147341 283913 2564 100 110 46 124 114651 244931 2073 127 46 37 57 100187 387072 4112 125 96 45 144 130332 246963 2340 93 128 39 126 134218 173260 2035 63 41 21 78 10901 346748 3241 108 146 50 153 145758 178402 1991 60 147 55 196 75767 268750 2828 96 121 40 130 134969 314070 2748 112 185 48 159 169216 1 2 0 0 0 0 0 14688 207 10 4 0 0 7953 98 5 1 0 0 0 0 455 8 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 291847 2449 95 85 46 94 105406 415421 3490 168 164 52 129 174586 0 0 0 0 0 0 0 203 4 4 0 0 0 0 7199 151 5 7 0 0 4245 46660 475 21 12 5 13 21509 17547 141 5 0 1 4 7670 121550 1145 46 37 48 89 15673 969 29 2 0 0 0 0 242774 2080 75 62 34 71 75882
Names of X columns:
Time_RFC Pageviews Logins Bloggend_computations Reviewed_compendiums Long_fbmessages_PR Time_compendium
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