Wessa.net

Send output to:

Data X:
94 1418 210907 30 103 869 120982 28 93 1530 176508 38 103 2172 179321 30 51 901 123185 22 70 463 52746 26 91 3201 385534 25 22 371 33170 18 38 1192 101645 11 93 1583 149061 26 60 1439 165446 25 123 1764 237213 38 148 1495 173326 44 90 1373 133131 30 124 2187 258873 40 70 1491 180083 34 168 4041 324799 47 115 1706 230964 30 71 2152 236785 31 66 1036 135473 23 134 1882 202925 36 117 1929 215147 36 108 2242 344297 30 84 1220 153935 25 156 1289 132943 39 120 2515 174724 34 114 2147 174415 31 94 2352 225548 31 120 1638 223632 33 81 1222 124817 25 110 1812 221698 33 133 1677 210767 35 122 1579 170266 42 158 1731 260561 43 109 807 84853 30 124 2452 294424 33 39 829 101011 13 92 1940 215641 32 126 2662 325107 36 0 186 7176 0 70 1499 167542 28 37 865 106408 14 38 1793 96560 17 120 2527 265769 32 93 2747 269651 30 95 1324 149112 35 77 2702 175824 20 90 1383 152871 28 80 1179 111665 28 31 2099 116408 39 110 4308 362301 34 66 918 78800 26 138 1831 183167 39 133 3373 277965 39 113 1713 150629 33 100 1438 168809 28 7 496 24188 4 140 2253 329267 39 61 744 65029 18 41 1161 101097 14 96 2352 218946 29 164 2144 244052 44 78 4691 341570 21 49 1112 103597 16 102 2694 233328 28 124 1973 256462 35 99 1769 206161 28 129 3148 311473 38 62 2474 235800 23 73 2084 177939 36 114 1954 207176 32 99 1226 196553 29 70 1389 174184 25 104 1496 143246 27 116 2269 187559 36 91 1833 187681 28 74 1268 119016 23 138 1943 182192 40 67 893 73566 23 151 1762 194979 40 72 1403 167488 28 120 1425 143756 34 115 1857 275541 33 105 1840 243199 28 104 1502 182999 34 108 1441 135649 30 98 1420 152299 33 69 1416 120221 22 111 2970 346485 38 99 1317 145790 26 71 1644 193339 35 27 870 80953 8 69 1654 122774 24 107 1054 130585 29 73 937 112611 20 107 3004 286468 29 93 2008 241066 45 129 2547 148446 37 69 1885 204713 33 118 1626 182079 33 73 1468 140344 25 119 2445 220516 32 104 1964 243060 29 107 1381 162765 28 99 1369 182613 28 90 1659 232138 31 197 2888 265318 52 36 1290 85574 21 85 2845 310839 24 139 1982 225060 41 106 1904 232317 33 50 1391 144966 32 64 602 43287 19 31 1743 155754 20 63 1559 164709 31 92 2014 201940 31 106 2143 235454 32 63 2146 220801 18 69 874 99466 23 41 1590 92661 17 56 1590 133328 20 25 1210 61361 12 65 2072 125930 17 93 1281 100750 30 114 1401 224549 31 38 834 82316 10 44 1105 102010 13 87 1272 101523 22 110 1944 243511 42 0 391 22938 1 27 761 41566 9 83 1605 152474 32 30 530 61857 11 80 1988 99923 25 98 1386 132487 36 82 2395 317394 31 0 387 21054 0 60 1742 209641 24 28 620 22648 13 9 449 31414 8 33 800 46698 13 59 1684 131698 19 49 1050 91735 18 115 2699 244749 33 140 1606 184510 40 49 1502 79863 22 120 1204 128423 38 66 1138 97839 24 21 568 38214 8 124 1459 151101 35 152 2158 272458 43 139 1111 172494 43 38 1421 108043 14 144 2833 328107 41 120 1955 250579 38 160 2922 351067 45 114 1002 158015 31 39 1060 98866 13 78 956 85439 28 119 2186 229242 31 141 3604 351619 40 101 1035 84207 30 56 1417 120445 16 133 3261 324598 37 83 1587 131069 30 116 1424 204271 35 90 1701 165543 32 36 1249 141722 27 50 946 116048 20 61 1926 250047 18 97 3352 299775 31 98 1641 195838 31 78 2035 173260 21 117 2312 254488 39 148 1369 104389 41 41 1577 136084 13 105 2201 199476 32 55 961 92499 18 132 1900 224330 39 44 1254 135781 14 21 1335 74408 7 50 1597 81240 17 0 207 14688 0 73 1645 181633 30 86 2429 271856 37 0 151 7199 0 13 474 46660 5 4 141 17547 1 57 1639 133368 16 48 872 95227 32 46 1318 152601 24 48 1018 98146 17 32 1383 79619 11 68 1314 59194 24 87 1335 139942 22 43 1403 118612 12 67 910 72880 19 46 616 65475 13 46 1407 99643 17 56 771 71965 15 48 766 77272 16 44 473 49289 24 60 1376 135131 15 65 1232 108446 17 55 1521 89746 18 38 572 44296 20 52 1059 77648 16 60 1544 181528 16 54 1230 134019 18 86 1206 124064 22 24 1205 92630 8 52 1255 121848 17 49 613 52915 18 61 721 81872 16 61 1109 58981 23 81 740 53515 22 43 1126 60812 13 40 728 56375 13 40 689 65490 16 56 592 80949 16 68 995 76302 20 79 1613 104011 22 47 2048 98104 17 57 705 67989 18 41 301 30989 17 29 1803 135458 12 3 799 73504 7 60 861 63123 17 30 1186 61254 14 79 1451 74914 23 47 628 31774 17 40 1161 81437 14 48 1463 87186 15 36 742 50090 17 42 979 65745 21 49 675 56653 18 57 1241 158399 18 12 676 46455 17 40 1049 73624 17 43 620 38395 16 33 1081 91899 15 77 1688 139526 21 43 736 52164 16 45 617 51567 14 47 812 70551 15 43 1051 84856 17 45 1656 102538 15 50 705 86678 15 35 945 85709 10 7 554 34662 6 71 1597 150580 22 67 982 99611 21 0 222 19349 1 62 1212 99373 18 54 1143 86230 17 4 435 30837 4 25 532 31706 10 40 882 89806 16 38 608 62088 16 19 459 40151 9 17 578 27634 16 67 826 76990 17 14 509 37460 7 30 717 54157 15 54 637 49862 14 35 857 84337 14 59 830 64175 18 24 652 59382 12 58 707 119308 16 42 954 76702 21 46 1461 103425 19 61 672 70344 16 3 778 43410 1 52 1141 104838 16 25 680 62215 10 40 1090 69304 19 32 616 53117 12 4 285 19764 2 49 1145 86680 14 63 733 84105 17 67 888 77945 19 32 849 89113 14 23 1182 91005 11 7 528 40248 4 54 642 64187 16 37 947 50857 20 35 819 56613 12 51 757 62792 15 39 894 72535 16
Names of X columns:
Writing Pageviews TimeRFC Reviews

Sample Range: (leave blank to include all observations)
From:
To:

Column Number of Endogenous Series (?)


Fixed Seasonal Effects


Type of Equation


Degree of Predetermination (lagged endogenous variables)


Degree of Seasonal Predetermination


Seasonality


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') }

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