Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1 812 58085 13 20 10345 10823 13 2 537 65968 26 28 17607 44480 27 3 186 7176 0 0 1423 1929 0 4 1405 78306 37 40 20050 30032 37 5 1859 123860 45 48 21212 27669 39 6 3347 226694 80 40 93979 114967 99 7 735 58032 21 35 15524 29951 21 8 609 72513 36 40 16182 38824 33 9 1100 65784 35 40 19238 26517 36 10 1743 164794 36 52 28909 63570 44 11 833 66288 35 24 22357 27131 33 12 1143 85319 46 44 25560 41061 47 13 888 45400 20 24 9954 18810 19 14 1460 78191 24 32 18490 27582 41 15 638 61175 18 28 17777 37026 22 16 854 72377 15 40 25268 24252 17 17 724 49850 48 40 37525 32579 46 18 323 15580 0 20 6023 0 0 19 1467 65240 37 67 25042 29666 31 20 412 13397 8 16 35713 7533 20 21 580 35385 10 44 7039 11892 10 22 1177 90047 51 36 40841 51557 55 23 595 47802 4 40 9214 5737 6 24 1103 61598 24 29 17446 11203 17 25 1037 73756 38 32 10295 28714 33 26 611 65152 19 28 13206 24268 33 27 1111 78226 20 41 26093 30749 32 28 542 66026 31 40 20744 46643 37 29 1341 170050 36 44 68013 64530 44 30 1169 91493 19 28 12840 35346 22 31 752 56374 20 56 12672 5766 15 32 889 85227 34 26 10872 29217 18 33 1009 50281 26 12 21325 15912 25 34 577 29008 0 32 24542 3728 7 35 1015 84775 29 36 16401 37494 35 36 0 0 0 0 0 0 0 37 562 55273 8 32 12821 13214 14 38 1115 62498 35 31 14662 19576 31 39 1015 35361 3 48 22190 13632 9 40 976 89502 41 72 37929 67378 59 41 940 73972 42 24 18009 29387 62 42 680 53655 10 56 11076 15936 12 43 404 40064 10 28 24981 18156 23 44 938 58480 26 36 30691 23750 31 45 580 48473 27 44 29164 15559 57 46 396 30737 0 32 13985 21713 23 47 256 27044 13 32 7588 12023 14 48 932 92011 30 32 20023 23588 31 49 734 56303 11 32 25524 28661 17 50 998 52792 24 36 14717 16874 24 51 425 33820 10 42 6832 11804 11 52 631 44121 14 28 9624 12949 16 53 903 103438 23 36 24300 38340 32 54 804 82720 27 32 21790 36573 36 55 915 89612 40 48 16493 40068 37 56 753 60722 22 20 9269 25561 25 57 674 64096 26 32 20105 31287 30 58 382 25090 8 32 11216 8383 10 59 550 57096 27 52 15569 29178 16 60 509 19608 0 40 21799 1237 3 61 423 28665 0 56 3772 10241 0 62 696 28400 16 24 6057 8219 17 63 460 27697 7 22 20828 9348 9 64 475 42406 18 36 9976 25242 22 65 373 47859 7 26 14055 24267 5 66 754 54987 24 44 17455 25902 23 67 936 58198 14 44 39553 51849 16 68 1501 61854 39 36 14818 29065 53 69 499 35185 16 36 17065 22417 23 70 80 12207 0 16 1536 1714 0 71 1517 108584 39 32 11938 29085 51 72 552 43273 17 10 24589 22118 25 73 517 39695 24 40 21332 14803 51 74 917 40699 27 25 13229 13243 46 75 691 38999 22 48 11331 13985 16 76 459 17667 0 36 853 657 0 77 683 59058 26 32 19821 26171 25 78 887 54106 19 24 34666 34867 34 79 410 23795 12 35 15051 12297 14 80 590 33465 23 17 27969 17487 32 81 439 36937 32 36 17897 13461 24 82 621 77075 19 40 6031 15192 16 83 537 32346 17 40 7153 16584 19 84 699 48592 25 36 13365 22892 27 85 477 26642 14 32 11197 7081 24 86 813 51086 11 40 25291 21623 12 87 1171 95985 20 60 28994 41992 43 88 400 24612 14 44 10461 11301 13 89 352 30113 14 28 16415 15230 19 90 639 53398 22 40 8495 14667 24 91 773 54198 25 28 18318 23795 27 92 1050 65255 35 36 25143 28055 26 93 489 59960 9 36 20471 29162 14 94 573 48096 16 20 14561 14962 26 95 334 17371 12 22 16902 8749 15 96 1229 115424 20 52 12994 37310 30 97 701 69334 33 48 29697 31551 33 98 222 19349 13 2 3895 9604 14 99 810 63594 11 44 9807 13937 11 100 739 49547 11 22 10711 16850 12 101 231 13066 8 3 2325 3439 8 102 425 25497 22 20 19000 16638 22 103 578 55049 13 32 22418 12847 12 104 305 24912 6 28 7872 13462 6 105 323 22431 12 24 5650 8086 10 106 463 24716 2 45 3979 2255 1 107 519 52452 33 40 14956 25918 31 108 294 17850 5 0 3738 3255 5 109 0 0 0 0 0 0 0 110 565 35269 34 28 10586 16138 35 111 462 27554 12 28 18122 5941 15 112 630 55167 34 32 17899 27123 36 113 498 36708 30 32 10913 19148 27 114 403 40920 21 13 18060 15214 36 115 38 3058 0 0 0 0 0 116 0 0 0 0 0 0 0 117 559 86153 28 40 15452 34998 29 118 592 37545 11 43 33996 18998 19 119 799 54332 9 32 8877 10651 16 120 406 33277 14 32 18708 13465 15 121 778 43410 7 3 2781 13 1 122 706 69693 41 28 20854 32505 36 123 367 31897 21 16 8179 15769 22 124 639 34563 28 37 7139 5936 16 125 481 39830 1 32 13798 4174 1 126 214 16145 10 4 5619 9876 10 127 538 38139 26 28 13050 17678 31 128 451 49667 7 36 11297 14633 22 129 629 48133 24 40 16170 13380 22 130 256 11796 1 8 0 0 0 131 80 7627 0 0 0 0 0 132 555 60315 11 21 20539 5652 10 133 41 6836 0 4 0 0 0 134 497 28834 17 12 10056 3636 9 135 42 5118 5 0 0 0 0 136 339 20825 4 6 2418 1695 0 137 0 0 0 0 0 0 0 138 375 32626 6 32 11806 8778 7 139 203 11747 0 36 15924 4148 2 140 81 7131 0 0 0 0 0 141 61 4194 0 0 0 0 0 142 313 21416 15 12 7084 10404 16 143 227 18648 0 24 14831 20794 25 144 462 38232 12 36 6585 11200 6
Names of X columns:
PlaatsHoF Pageviews TimeRFC BloggedComp PeerReviews CharComp SecComp HypComp
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