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