Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
586 209 112285 145 336 212 84786 101 490 239 83123 98 498 219 101193 132 342 119 38361 60 147 171 68504 38 1071 187 119182 144 92 89 22807 5 282 82 17140 28 414 193 116174 84 460 153 57635 79 659 263 66198 127 481 314 71701 78 370 189 57793 60 719 263 80444 131 500 200 53855 84 902 349 97668 133 642 231 133824 150 658 187 101481 91 376 154 99645 132 564 273 114789 136 598 252 99052 124 956 216 67654 118 428 173 65553 70 369 312 97500 107 485 249 69112 119 484 232 82753 89 627 212 85323 112 621 245 72654 108 347 176 30727 52 616 236 77873 112 585 268 117478 116 473 276 74007 123 724 323 90183 125 236 222 61542 27 818 251 101494 162 281 91 27570 32 599 213 55813 64 903 262 79215 92 20 0 1423 0 465 178 55461 83 296 83 31081 41 268 92 22996 47 738 244 83122 120 749 208 70106 105 414 223 60578 79 488 157 39992 65 425 187 79892 70 310 184 49810 55 323 90 71570 39 1006 235 100708 67 219 148 33032 21 509 287 82875 127 772 282 139077 152 418 235 71595 113 469 218 72260 99 67 19 5950 7 915 284 115762 141 181 128 32551 21 281 93 31701 35 608 204 80670 109 678 330 143558 133 949 158 117105 123 288 109 23789 26 648 209 120733 230 712 251 105195 166 573 206 73107 68 865 275 132068 147 655 146 149193 179 494 214 46821 61 575 237 87011 101 546 210 95260 108 484 168 55183 90 398 209 106671 114 521 251 73511 103 521 198 92945 142 331 159 78664 79 506 293 70054 88 204 155 22618 25 542 306 74011 83 465 176 83737 113 399 252 69094 118 765 242 93133 110 676 213 95536 129 508 233 225920 51 377 224 62133 93 423 220 61370 76 334 154 43836 49 962 258 106117 118 405 198 38692 38 537 158 84651 141 225 55 56622 58 341 159 15986 27 363 216 95364 91 313 151 26706 48 796 218 89691 63 670 251 67267 56 412 270 126846 144 569 191 41140 73 506 242 102860 168 390 166 51715 64 613 243 55801 97 675 216 111813 117 452 215 120293 100 507 198 138599 149 645 207 161647 187 737 396 115929 127 238 114 24266 37 863 176 162901 245 625 297 109825 87 645 232 129838 177 403 172 37510 49 120 135 43750 49 433 106 40652 73 458 178 87771 177 561 211 85872 94 654 230 89275 117 613 135 44418 60 276 160 192565 55 257 86 35232 39 370 134 40909 64 170 64 13294 26 350 133 32387 64 280 212 140867 58 624 231 120662 95 229 77 21233 25 283 94 44332 26 282 175 61056 76 676 265 101338 129 64 0 1168 11 115 63 13497 2 424 206 65567 101 172 62 25162 28 278 179 32334 36 368 234 40735 89 882 199 91413 193 58 0 855 4 582 148 97068 84 63 67 44339 23 87 34 14116 39 130 85 10288 14 366 134 65622 78 255 120 16563 14 680 239 76643 101 513 291 110681 82 222 120 29011 24 357 265 92696 36 272 153 94785 75 106 48 8773 16 420 255 83209 55 757 314 93815 131 479 304 86687 131 300 92 34553 39 911 303 105547 144 696 267 103487 139 975 330 213688 211 439 233 71220 78 275 88 23517 50 237 182 56926 39 637 239 91721 90 977 291 115168 166 234 213 111194 12 335 115 51009 57 902 269 135777 133 364 190 51513 69 567 246 74163 119 460 205 51633 119 394 143 75345 65 322 125 33416 61 695 132 83305 49 833 217 98952 101 544 214 102372 196 481 157 37238 15 707 267 103772 136 290 304 123969 89 378 92 27142 40 554 223 135400 123 257 126 21399 21 623 276 130115 163 377 91 24874 29 207 49 34988 35 226 118 45549 13 41 0 6023 5 505 183 64466 96 755 233 54990 151 20 0 1644 6 130 28 6179 13 49 8 3926 3 370 121 32755 56 265 159 34777 23 424 131 73224 57 273 116 27114 14 221 72 20760 43 164 148 37636 20 389 175 65461 72 329 91 30080 87 202 143 24094 21 182 97 69008 56 277 113 54968 59 200 115 46090 82 215 109 27507 43 137 120 10672 25 375 120 34029 38 301 133 46300 25 249 126 24760 38 123 114 18779 12 216 114 21280 29 504 121 40662 47 372 121 28987 45 345 174 22827 40 257 54 18513 30 338 116 30594 41 147 117 24006 25 227 125 27913 23 164 152 42744 14 149 169 12934 16 169 95 22574 26 157 89 41385 21 182 102 18653 27 225 117 18472 9 212 144 30976 33 289 167 63339 42 273 113 25568 68 189 128 33747 32 86 109 4154 6 376 77 19474 67 204 28 35130 33 175 128 39067 77 170 71 13310 46 208 169 65892 30 88 113 4143 0 226 94 28579 36 242 107 51776 46 139 96 21152 18 183 119 38084 48 157 117 27717 29 440 129 32928 28 129 79 11342 34 205 104 19499 33 107 106 16380 34 255 92 36874 33 388 161 48259 80 145 107 16734 32 143 101 28207 30 196 101 30143 41 236 110 41369 41 285 103 45833 51 241 109 29156 18 238 75 35944 34 96 29 36278 31 418 154 45588 39 277 148 45097 54 54 2 3895 14 276 134 28394 24 240 115 18632 24 86 19 2325 8 88 57 25139 26 249 102 27975 19 172 96 14483 11 112 55 13127 14 77 76 5839 1 214 135 24069 39 104 35 3738 5 150 85 18625 37 139 108 36341 32 234 90 24548 38 178 131 21792 47 165 65 26263 47 331 119 23686 37 213 109 49303 51 287 122 25659 45 195 125 28904 21 121 6 2781 1 291 115 29236 42 173 65 19546 26 193 109 22818 21 148 80 32689 4 55 12 5752 10 241 101 22197 43 234 129 20055 34 217 143 25272 31 248 75 82206 19 253 62 32073 34 112 21 5444 6 178 115 20154 11 141 108 36944 24 157 79 8019 16 174 111 30884 72 201 103 19540 21
Names of X columns:
Time_rfc feedbackmsg totsize totblogs
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