Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
305687 3615 93 1415 2 26 86997 305115 2637 78 1264 0 20 91256 280379 1883 55 809 1 25 55709 280039 2900 113 1008 4 29 92046 274949 2460 65 846 0 30 75741 264528 2057 83 749 0 30 59635 257662 1736 198 591 7 31 84607 254599 2145 71 799 3 35 162365 253056 2597 85 1170 0 27 104911 245478 3018 119 1120 0 35 70817 245107 2367 86 824 6 31 109104 244909 2692 79 1100 9 21 73586 243180 2193 71 904 8 22 120087 242153 2207 49 1013 2 31 72631 236316 1836 63 786 1 22 58233 234863 1912 55 798 1 27 85224 220835 2310 106 904 1 23 67271 213487 2703 67 1008 6 26 117986 213310 2144 54 1040 8 22 55071 209631 2000 107 767 2 24 63717 208823 1633 74 682 0 26 81493 201748 1565 65 569 0 33 86281 201603 2219 92 709 7 40 83038 201409 2156 75 806 6 21 114425 197067 2451 113 751 5 24 101653 197033 1740 68 563 7 30 63958 193662 1541 47 601 0 33 65196 192887 1701 41 690 3 36 62932 191467 1416 55 611 3 20 79194 190729 1313 61 506 1 30 64664 189764 1474 54 555 0 24 123328 189066 1328 44 601 3 25 72369 187289 1543 37 566 0 30 54628 185366 1557 67 537 1 29 111436 185288 1717 71 582 1 27 38885 185279 1809 100 730 3 22 73795 183260 1793 190 600 4 24 70111 183059 2061 73 740 1 23 57637 182557 1589 40 603 0 26 103646 181853 1458 52 572 3 25 96750 179571 1792 57 476 5 35 101773 176577 1354 50 555 4 20 76168 175663 1583 62 608 0 24 74482 173587 1612 27 654 1 20 71170 173260 2035 63 716 3 21 37238 170635 1637 59 584 6 26 70027 170588 1167 46 333 2 26 95556 169613 1970 51 735 1 24 48204 169569 1285 42 472 4 20 105965 169093 1445 35 585 5 17 85903 168059 1109 33 391 0 26 60029 167255 1557 37 669 0 25 37048 167226 1358 53 531 0 30 43460 166142 1191 40 393 4 23 90257 161729 1772 79 690 4 21 65911 160905 1285 54 387 0 27 56316 157566 1566 54 472 0 30 61704 156990 1339 62 512 0 26 52295 155012 1593 49 472 5 28 74349 154730 1297 45 423 0 27 82204 152366 1281 54 446 0 24 83042 152193 1356 49 450 2 25 76013 148857 1263 61 411 6 31 91939 145908 1143 37 527 2 24 65724 145120 1850 89 703 0 24 56699 144530 1787 72 833 2 25 79774 143937 1407 48 546 2 20 68608 142339 1145 29 397 2 20 125410 142286 1899 99 627 8 28 57231 141933 1323 55 427 0 27 51370 141150 1569 60 684 5 31 36311 139409 1667 49 678 2 24 99518 139144 828 23 344 0 21 56530 137544 1128 35 388 7 31 94137 135306 1233 28 571 0 22 71181 134088 1192 50 453 9 20 55901 132798 1176 53 570 5 22 38417 131337 1110 45 439 3 20 54506 131108 1496 39 646 3 30 56733 130539 1158 24 420 0 20 48821 130533 1030 27 387 0 20 85168 130413 1935 75 756 0 24 55027 129796 1154 55 385 4 28 38439 129340 1213 47 392 4 33 53009 129100 897 37 363 2 19 73713 128873 1275 56 447 2 20 42564 128768 1405 50 503 1 26 38650 128734 1107 53 342 0 18 55064 128274 1155 74 358 7 37 63262 128075 1223 56 329 2 25 64102 127930 1171 91 441 0 21 66477 127394 1372 44 504 4 15 34497 127185 800 38 286 0 33 73087 126630 1310 44 449 5 25 58425 125927 1264 53 474 0 24 51360 121976 1105 48 366 2 20 42051 121630 1108 47 420 1 21 28340 120362 1113 42 438 0 25 49319 118807 1348 33 468 11 25 55827 117805 1978 70 727 1 27 99501 115911 1025 40 445 5 25 40001 115885 1355 36 575 5 19 77411 113450 1253 85 413 4 19 89041 113337 1053 37 371 9 24 63016 112004 1196 42 403 4 21 37361 109237 1473 39 641 0 21 15430 108715 1075 32 304 0 15 40671 107434 853 35 320 0 19 82043 106888 1035 34 406 0 21 26982 106351 995 108 341 0 20 29467 106193 956 58 271 6 23 202316 105477 1020 33 341 2 16 49288 102350 1119 43 435 6 23 50466 101324 860 31 297 5 26 70780 98791 1209 30 447 1 18 36252 98466 1277 47 495 4 24 43448 98066 1101 58 434 3 14 31701 96981 983 33 334 0 22 56979 96634 810 35 242 5 22 72571 93125 1735 49 836 1 21 50838 91185 973 31 287 0 27 21067 90961 901 25 298 1 22 63785 90938 767 17 262 3 15 37137 89882 993 34 382 5 17 59155 89318 911 36 292 1 22 44970 89059 1069 64 345 0 20 46765 86621 669 48 223 4 20 54565 81530 668 30 178 1 15 31258 81106 1020 31 300 4 21 35838 80964 686 26 216 1 8 26998 80953 870 25 437 0 8 56622 78800 918 42 330 2 26 33032 76470 809 29 312 0 20 35606 75746 672 72 238 0 12 47261 75032 777 45 240 5 23 62147 74112 668 32 215 0 19 174949 73567 705 27 187 0 23 23238 71908 938 28 349 2 17 62832 69471 837 28 364 6 20 22618 67507 1101 39 368 5 32 78956 65029 744 17 255 5 18 32551 62731 547 25 168 4 20 36990 61857 530 25 192 4 11 25162 50999 588 15 225 8 20 63989 46660 474 20 259 0 5 6179 43287 602 14 214 4 19 43750 38214 568 34 276 0 8 8773 35523 308 17 106 2 16 52491 32750 345 16 102 0 18 22807 31414 449 19 200 0 8 14116 24188 496 24 218 0 4 5950 22938 391 10 154 0 1 1168 21054 387 16 146 0 0 855 17547 141 5 69 0 1 3926 14688 207 10 85 0 0 6023 7199 151 5 74 0 0 1644 969 29 2 0 0 0 0 455 8 2 0 0 0 0 203 4 4 0 0 0 0 98 5 1 0 0 0 0 0 0 0 0 9 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
Names of X columns:
Time_RFC #_pageviews Logins Compendiums_views shared_compendiums reviewed_compendiums Compendium_writing
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