Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
8976 102 918 88 792 9 10494 99 297 106 318 3 6790 97 194 70 140 2 5740 82 1722 70 1470 21 4312 77 770 56 560 10 3250 65 130 50 100 2 3072 64 256 48 192 4 4402 62 248 71 284 4 3782 62 248 61 244 4 4092 62 310 66 330 5 4880 61 122 80 160 2 2183 59 177 37 111 3 3021 57 171 53 159 3 2184 56 336 39 234 6 2160 54 162 40 120 3 3186 54 216 59 236 4 2226 53 159 42 126 3 1716 52 676 33 429 13 1836 51 153 36 108 3 2907 51 204 57 228 4 1938 51 408 38 304 8 4900 50 400 98 784 8 2150 50 150 43 129 3 3650 50 200 73 292 4 2548 49 98 52 104 2 2597 49 245 53 265 5 2499 49 196 51 204 4 1536 48 144 32 96 3 2064 48 144 43 129 3 2491 47 94 53 106 2 2350 47 141 50 150 3 2300 46 138 50 150 3 2576 46 138 56 168 3 2385 45 225 53 265 5 2115 45 135 47 141 3 1890 45 180 42 168 4 1276 44 132 29 87 3 2322 43 172 54 216 4 1680 42 336 40 320 8 1722 42 126 41 123 3 1554 42 168 37 148 4 1050 42 84 25 50 2 1134 42 210 27 135 5 2562 42 168 61 244 4 2214 41 287 54 378 7 1435 41 123 35 105 3 2255 41 164 55 220 4 1927 41 246 47 282 6 2009 41 287 49 343 7 1558 41 820 38 760 20 2132 41 2009 52 2548 49 1400 40 120 35 105 3 2080 40 120 52 156 3 2160 40 240 54 324 6 1600 40 240 40 240 6 2080 40 160 52 208 4 1326 39 195 34 170 5 1989 39 156 51 204 4 1634 38 152 43 172 4 1520 38 1178 40 1240 31 1368 36 108 38 114 3 1188 36 108 33 99 3 945 35 140 27 108 4 1190 35 210 34 204 6 1540 35 175 44 220 5 1610 35 105 46 138 3 1700 34 102 50 150 3 1054 34 68 31 62 2 1122 34 102 33 99 3 1221 33 99 37 111 3 1584 33 528 48 768 16 1089 33 99 33 99 3 1280 32 96 40 120 3 672 32 96 21 63 3 1056 32 64 33 66 2 1271 31 155 41 205 5 1085 31 93 35 105 3 1800 30 120 60 240 4 900 30 150 30 150 5 1350 30 60 45 90 2 780 30 90 26 78 3 1189 29 87 41 123 3 1344 28 392 48 672 14 280 28 224 10 80 8 945 27 108 35 140 4 621 27 108 23 92 4 783 27 81 29 87 3 442 26 104 17 68 4 875 25 75 35 105 3 1250 25 125 50 250 5 825 25 75 33 99 3 552 24 72 23 69 3 528 24 48 22 44 2 1196 23 92 52 208 4 874 23 713 38 1178 31 736 23 46 32 64 2 644 23 115 28 140 5 989 23 115 43 215 5 704 22 44 32 64 2 770 22 44 35 70 2 550 22 66 25 75 3 308 22 176 14 112 8 340 20 120 17 102 6 342 19 57 18 54 3 228 19 38 12 24 2 459 17 85 27 135 5 476 17 51 28 84 3 192 16 80 12 60 5 336 16 80 21 105 5 45 5 20 9 36 4 44 4 8 11 22 2 9 3 12 3 12 4 17316 0 624 0 444 0 14933 0 872 0 1096 0 11648 0 312 0 336 0 7154 0 392 0 292 0 7722 0 234 0 297 0 8855 0 231 0 345 0 6935 0 219 0 285 0 4260 0 284 0 240 0 6298 0 268 0 376 0 4480 0 320 0 350 0 5394 0 124 0 174 0 6222 0 183 0 306 0 4002 0 232 0 276 0 6438 0 406 0 777 0 3080 0 168 0 165 0 6608 0 224 0 472 0 4680 0 156 0 270 0 4131 0 204 0 324 0 4488 0 204 0 352 0 3150 0 150 0 189 0 4116 0 294 0 504 0 4263 0 196 0 348 0 3744 0 192 0 312 0 4371 0 188 0 372 0 3243 0 188 0 276 0 3082 0 138 0 201 0 2745 0 270 0 366 0 5535 0 180 0 492 0 4095 0 270 0 546 0 4410 0 270 0 588 0 1672 0 88 0 76 0 3168 0 132 0 216 0 2596 0 132 0 177 0 3354 0 86 0 156 0 2494 0 172 0 232 0 4074 0 210 0 485 0 2829 0 123 0 207 0 2050 0 287 0 350 0 2640 0 160 0 264 0 2730 0 117 0 210 0 2535 0 156 0 260 0 2691 0 156 0 276 0 1911 0 117 0 147 0 2808 0 117 0 216 0 2886 0 156 0 296 0 3198 0 195 0 410 0 2318 0 114 0 183 0 2736 0 152 0 288 0 2926 0 228 0 462 0 2432 0 190 0 320 0 851 0 259 0 161 0 1443 0 185 0 195 0 3219 0 185 0 435 0 1656 0 108 0 138 0 2376 0 180 0 330 0 2052 0 144 0 228 0 1728 0 324 0 432 0 2700 0 108 0 225 0 1260 0 108 0 105 0 1855 0 105 0 159 0 2100 0 105 0 180 0 680 0 510 0 300 0 2244 0 136 0 264 0 1156 0 204 0 204 0 2720 0 102 0 240 0 2142 0 102 0 189 0 1518 0 99 0 138 0 660 0 165 0 100 0 2409 0 99 0 219 0 1881 0 132 0 228 0 2145 0 231 0 455 0 2310 0 132 0 280 0 1696 0 160 0 265 0 1920 0 224 0 420 0 1088 0 448 0 476 0 576 0 800 0 450 0 1568 0 192 0 294 0 837 0 124 0 108 0 1395 0 93 0 135 0 279 0 1922 0 558 0 690 0 150 0 115 0 1830 0 300 0 610 0 1943 0 116 0 268 0 2088 0 145 0 360 0 1682 0 145 0 290 0 1540 0 112 0 220 0 924 0 280 0 330 0 1120 0 140 0 200 0 1596 0 84 0 171 0 1708 0 84 0 183 0 2436 0 476 0 1479 0 1755 0 108 0 260 0 2295 0 162 0 510 0 2295 0 81 0 255 0 1404 0 104 0 216 0 624 0 208 0 192 0 806 0 78 0 93 0 1664 0 104 0 256 0 1750 0 100 0 280 0 50 0 1175 0 94 0 648 0 192 0 216 0 696 0 72 0 87 0 1632 0 120 0 340 0 1008 0 72 0 126 0 1872 0 96 0 312 0 312 0 720 0 390 0 1248 0 96 0 208 0 575 0 276 0 300 0 874 0 184 0 304 0 920 0 69 0 120 0 966 0 184 0 336 0 920 0 92 0 160 0 1702 0 69 0 222 0 1679 0 92 0 292 0 1232 0 88 0 224 0 66 0 462 0 63 0 189 0 252 0 108 0 1428 0 63 0 204 0 588 0 63 0 84 0 756 0 84 0 144 0 760 0 120 0 228 0 1100 0 340 0 935 0 720 0 60 0 108 0 340 0 360 0 306 0 1080 0 100 0 270 0 1083 0 95 0 285 0 570 0 304 0 480 0 760 0 190 0 400 0 666 0 90 0 185 0 828 0 72 0 184 0 576 0 54 0 96 0 612 0 90 0 170 0 396 0 72 0 88 0 1003 0 85 0 295 0 544 0 170 0 320 0 288 0 192 0 216 0 448 0 64 0 112 0 510 0 135 0 306 0 435 0 180 0 348 0 360 0 150 0 240 0 360 0 135 0 216 0 322 0 238 0 391 0 559 0 78 0 258 0 364 0 39 0 84 0 228 0 48 0 76 0 176 0 209 0 304 0 440 0 33 0 120 0 140 0 90 0 126 0 190 0 70 0 133 0 220 0 40 0 88 0 80 0 30 0 24 0 279 0 414 0 1426 0 72 0 248 0 279 0 144 0 168 0 378 0 63 0 49 0 63 0 35 0 203 0 145 0 44 0 20 0 55 0
Names of X columns:
hours_blogs hours_uk hours_spr blogs_uk blogs_spr uk_spr
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