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