Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
279055 73 504 96 42 130 186099 209884 73 502 75 38 143 113854 233939 83 710 70 46 118 99776 222117 106 1154 134 42 146 106194 179751 54 402 72 30 73 100792 70849 28 179 8 35 89 47552 568125 131 2452 169 40 146 250931 33186 19 111 1 18 22 6853 227332 62 763 88 38 132 115466 258874 48 650 98 37 92 110896 351915 118 933 106 46 147 169351 260484 129 728 122 60 203 94853 204003 83 764 57 37 113 72591 368577 85 1186 139 55 171 101345 269455 88 724 87 44 87 113713 395936 187 1758 176 63 208 165354 335567 76 845 114 40 153 164263 423110 171 1382 121 43 97 135213 182016 58 514 103 32 95 111669 267365 88 692 135 52 197 134163 279428 73 847 123 49 160 140303 508849 111 1397 99 41 148 150773 206722 47 533 74 25 84 111848 200004 58 636 103 57 227 102509 257139 132 1370 158 45 154 96785 270815 137 1090 116 42 151 116136 296850 133 1149 102 45 142 158376 307100 90 715 132 43 148 153990 184160 58 639 62 36 110 64057 393860 79 1213 150 45 149 230054 327660 89 1111 143 50 179 184531 252512 82 728 50 50 149 114198 373013 102 885 141 51 187 198299 115602 46 410 48 42 153 33750 430118 103 1293 141 44 163 189723 273950 56 1186 83 42 127 100826 428077 128 1348 112 44 151 188355 251349 91 689 79 40 100 104470 115658 34 284 33 17 46 58391 388812 208 1304 149 43 156 164808 343783 85 1556 126 41 128 134097 207021 76 770 85 41 111 80238 214344 81 676 84 40 119 133252 182398 66 487 68 49 148 54518 157164 84 1051 50 52 65 121850 459455 157 2089 101 42 134 79367 78800 42 330 20 26 66 56968 217932 84 694 101 59 201 106314 368086 122 1410 150 50 177 191889 215843 67 1090 118 50 156 104864 244765 80 690 99 47 158 160792 24188 24 218 8 4 7 15049 399093 333 862 88 51 175 191179 65029 17 255 21 18 61 25109 101097 64 454 30 14 41 45824 300488 64 1208 97 41 133 129711 369627 90 785 163 61 228 210012 367127 204 1208 132 40 140 194679 374193 152 1096 161 44 155 197680 270099 88 887 89 40 141 81180 391871 151 1335 160 51 181 197765 315924 121 1190 139 29 75 214738 291391 124 1257 104 43 97 96252 295075 93 1030 103 42 142 124527 276201 78 658 66 41 136 153242 267432 71 542 163 30 87 145707 215924 140 651 93 39 140 113963 256641 157 888 85 51 169 134904 260919 87 913 150 40 129 114268 182961 73 637 143 29 92 94333 256967 74 900 107 47 160 102204 73566 32 385 22 23 67 23824 272362 93 784 85 48 179 111563 220707 61 891 91 38 90 91313 228835 68 779 131 42 144 89770 371391 91 1001 140 46 144 100125 398210 104 1265 156 40 144 165278 220401 110 586 81 45 134 181712 229333 70 765 137 42 146 80906 217623 71 737 102 41 121 75881 200046 53 766 72 37 112 83963 483074 131 1272 161 47 145 175721 145943 71 653 30 26 99 68580 295224 108 703 120 48 96 136323 80953 25 437 49 8 27 55792 180759 61 936 71 27 77 25157 179344 61 459 76 38 137 100922 415550 221 1586 85 41 151 118845 369093 128 1053 146 61 126 170492 180679 106 1051 165 45 159 81716 299505 104 846 89 41 101 115750 292260 84 732 168 42 144 105590 199481 67 632 48 35 102 92795 282361 78 1128 149 36 135 82390 329281 89 971 75 40 147 135599 234577 48 711 107 40 155 127667 297995 67 738 116 38 138 163073 305984 88 820 165 43 113 211381 416463 163 1369 155 65 248 189944 414359 118 1501 165 33 116 226168 297080 142 893 121 51 176 117495 318283 70 902 156 45 140 195894 222281 197 782 86 36 59 80684 43287 14 214 13 19 64 19630 223456 86 795 113 25 40 88634 258249 158 874 112 44 98 139292 299566 60 1275 133 45 139 128602 321797 95 1079 169 44 135 135848 174736 89 443 30 35 97 178377 169579 102 977 121 46 142 106330 354041 77 677 82 44 155 178303 303273 90 696 148 45 115 116938 23668 13 156 12 1 0 5841 196743 79 785 146 40 103 106020 61857 25 192 23 11 30 24610 207339 53 606 84 51 130 74151 431443 123 1234 163 38 102 232241 21054 16 146 4 0 0 6622 252805 52 866 81 30 77 127097 31961 22 200 18 8 9 13155 360401 124 1350 118 43 150 160501 251240 76 735 76 48 163 91502 187003 96 522 55 49 148 24469 180842 58 724 62 32 94 88229 38214 34 276 16 8 21 13983 278173 55 859 98 43 151 80716 358276 84 1031 137 52 187 157384 211775 66 511 50 53 171 122975 445926 89 1708 152 49 170 191469 348017 99 884 163 48 145 231257 441946 133 1201 142 56 198 258287 210700 42 559 77 45 152 122531 126320 46 478 59 40 112 61394 316128 361 1005 94 48 173 86480 466139 198 1574 128 50 177 195791 162279 62 575 63 43 153 18284 412099 139 1812 127 46 161 147581 173802 83 755 59 40 115 72558 292443 54 668 118 45 147 147341 283913 100 905 110 46 124 114651 243609 124 682 45 37 57 100187 387072 125 1613 96 45 144 130332 246963 92 811 128 39 126 134218 173260 63 716 41 21 78 10901 346748 108 1034 146 50 153 145758 176654 58 732 147 55 196 75767 264767 92 1060 121 40 130 134969 314070 112 852 185 48 159 169216 1 0 0 0 0 0 0 14688 10 85 4 0 0 7953 98 1 0 0 0 0 0 455 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 284420 92 809 85 46 94 105406 410509 164 1134 157 52 129 174586 0 0 0 0 0 0 0 203 4 0 0 0 0 0 7199 5 74 7 0 0 4245 46660 20 259 12 5 13 21509 17547 5 69 0 1 4 7670 121550 46 309 37 48 89 15673 969 2 0 0 0 0 0 242258 74 690 62 34 71 75882
Names of X columns:
Time Logins CompendiumViews BloggedComputations ReviewedCompendiums LongFeedbackmessages WritingTime
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