Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1418 56 81 94 869 56 55 103 1530 54 50 93 2172 89 125 103 901 40 40 51 463 25 37 70 3201 92 63 91 371 18 44 22 1192 63 88 38 1583 44 66 93 1439 33 57 60 1764 84 74 123 1495 88 49 148 1373 55 52 90 2187 60 88 124 1491 66 36 70 4041 154 108 168 1706 53 43 115 2152 119 75 71 1036 41 32 66 1882 61 44 134 1929 58 85 117 2242 75 86 108 1220 33 56 84 1289 40 50 156 2515 92 135 120 2147 100 63 114 2352 112 81 94 1638 73 52 120 1222 40 44 81 1812 45 113 110 1677 60 39 133 1579 62 73 122 1731 75 48 158 807 31 33 109 2452 77 59 124 829 34 41 39 1940 46 69 92 2662 99 64 126 186 17 1 0 1499 66 59 70 865 30 32 37 1793 76 129 38 2527 146 37 120 2747 67 31 93 1324 56 65 95 2702 107 107 77 1383 58 74 90 1179 34 54 80 2099 61 76 31 4308 119 715 110 918 42 57 66 1831 66 66 138 3373 89 106 133 1713 44 54 113 1438 66 32 100 496 24 20 7 2253 259 71 140 744 17 21 61 1161 64 70 41 2352 41 112 96 2144 68 66 164 4691 168 190 78 1112 43 66 49 2694 132 165 102 1973 105 56 124 1769 71 61 99 3148 112 53 129 2474 94 127 62 2084 82 63 73 1954 70 38 114 1226 57 50 99 1389 53 52 70 1496 103 42 104 2269 121 76 116 1833 62 67 91 1268 52 50 74 1943 52 53 138 893 32 39 67 1762 62 50 151 1403 45 77 72 1425 46 57 120 1857 63 73 115 1840 75 34 105 1502 88 39 104 1441 46 46 108 1420 53 63 98 1416 37 35 69 2970 90 106 111 1317 63 43 99 1644 78 47 71 870 25 31 27 1654 45 162 69 1054 46 57 107 937 41 36 73 3004 144 263 107 2008 82 78 93 2547 91 63 129 1885 71 54 69 1626 63 63 118 1468 53 77 73 2445 62 79 119 1964 63 110 104 1381 32 56 107 1369 39 56 99 1659 62 43 90 2888 117 111 197 1290 34 71 36 2845 92 62 85 1982 93 56 139 1904 54 74 106 1391 144 60 50 602 14 43 64 1743 61 68 31 1559 109 53 63 2014 38 87 92 2143 73 46 106 2146 75 105 63 874 50 32 69 1590 61 133 41 1590 55 79 56 1210 77 51 25 2072 75 207 65 1281 72 67 93 1401 50 47 114 834 32 34 38 1105 53 66 44 1272 42 76 87 1944 71 65 110 391 10 9 0 761 35 42 27 1605 65 45 83 530 25 25 30 1988 66 115 80 1386 41 97 98 2395 86 53 82 387 16 2 0 1742 42 52 60 620 19 44 28 449 19 22 9 800 45 35 33 1684 65 74 59 1050 35 103 49 2699 95 144 115 1606 49 60 140 1502 37 134 49 1204 64 89 120 1138 38 42 66 568 34 52 21 1459 32 98 124 2158 65 99 152 1111 52 52 139 1421 62 29 38 2833 65 125 144 1955 83 106 120 2922 95 95 160 1002 29 40 114 1060 18 140 39 956 33 43 78 2186 247 128 119 3604 139 142 141 1035 29 73 101 1417 118 72 56 3261 110 128 133 1587 67 61 83 1424 42 73 116 1701 65 148 90 1249 94 64 36 946 64 45 50 1926 81 58 61 3352 95 97 97 1641 67 50 98 2035 63 37 78 2312 83 50 117 1369 45 105 148 1577 30 69 41 2201 70 46 105 961 32 57 55 1900 83 52 132 1254 31 98 44 1335 67 61 21 1597 66 89 50 207 10 0 0 1645 70 48 73 2429 103 91 86 151 5 0 0 474 20 7 13 141 5 3 4 1639 36 54 57 872 34 70 48 1318 48 36 46 1018 40 37 48 1383 43 123 32 1314 31 247 68 1335 42 46 87 1403 46 72 43 910 33 41 67 616 18 24 46 1407 55 45 46 771 35 33 56 766 59 27 48 473 19 36 44 1376 66 87 60 1232 60 90 65 1521 36 114 55 572 25 31 38 1059 47 45 52 1544 54 69 60 1230 53 51 54 1206 40 34 86 1205 40 60 24 1255 39 45 52 613 14 54 49 721 45 25 61 1109 36 38 61 740 28 52 81 1126 44 67 43 728 30 74 40 689 22 38 40 592 17 30 56 995 31 26 68 1613 55 67 79 2048 54 132 47 705 21 42 57 301 14 35 41 1803 81 118 29 799 35 68 3 861 43 43 60 1186 46 76 30 1451 30 64 79 628 23 48 47 1161 38 64 40 1463 54 56 48 742 20 71 36 979 53 75 42 675 45 39 49 1241 39 42 57 676 20 39 12 1049 24 93 40 620 31 38 43 1081 35 60 33 1688 151 71 77 736 52 52 43 617 30 27 45 812 31 59 47 1051 29 40 43 1656 57 79 45 705 40 44 50 945 44 65 35 554 25 10 7 1597 77 124 71 982 35 81 67 222 11 15 0 1212 63 92 62 1143 44 42 54 435 19 10 4 532 13 24 25 882 42 64 40 608 38 45 38 459 29 22 19 578 20 56 17 826 27 94 67 509 20 19 14 717 19 35 30 637 37 32 54 857 26 35 35 830 42 48 59 652 49 49 24 707 30 48 58 954 49 62 42 1461 67 96 46 672 28 45 61 778 19 63 3 1141 49 71 52 680 27 26 25 1090 30 48 40 616 22 29 32 285 12 19 4 1145 31 45 49 733 20 45 63 888 20 67 67 849 39 30 32 1182 29 36 23 528 16 34 7 642 27 36 54 947 21 34 37 819 19 37 35 757 35 46 51 894 14 44 39
Names of X columns:
pageviews logins compendium_views_pr feedback_messages_p120
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