Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
146455 1 22 68 128 95556 84944 4 20 72 89 54565 113337 9 24 37 68 63016 128655 2 21 70 108 79774 74398 1 15 30 51 31258 35523 2 16 53 33 52491 293403 0 20 74 119 91256 32750 0 18 22 5 22807 106539 5 19 68 63 77411 130539 0 20 47 66 48821 154991 0 25 87 98 52295 126683 7 37 123 71 63262 100672 6 23 69 55 50466 179562 3 28 89 116 62932 125971 4 25 45 71 38439 234509 0 35 122 120 70817 158980 4 20 75 122 105965 184217 3 22 45 74 73795 107342 0 19 53 111 82043 141371 5 26 96 103 74349 154730 0 27 82 98 82204 264020 1 22 76 100 55709 90938 3 15 51 42 37137 101324 5 26 104 100 70780 130232 0 24 83 105 55027 137793 0 22 78 77 56699 161678 4 21 59 83 65911 151503 0 23 83 98 56316 105324 0 21 71 46 26982 175914 0 25 81 95 54628 181853 3 25 93 91 96750 114928 4 28 72 91 53009 190410 1 30 107 94 64664 61499 4 20 75 15 36990 223004 1 23 84 137 85224 167131 0 25 69 56 37048 233482 0 26 90 78 59635 121185 2 20 51 68 42051 78776 1 8 18 34 26998 188967 2 20 75 94 63717 199512 8 21 59 82 55071 102531 5 25 63 63 40001 118958 3 20 68 58 54506 68948 4 18 47 43 35838 93125 1 21 29 36 50838 277108 2 22 69 64 86997 78800 2 26 66 21 33032 157250 0 30 106 104 61704 210554 6 24 73 124 117986 127324 3 26 87 101 56733 114397 0 18 65 85 55064 24188 0 4 7 7 5950 246209 6 31 111 124 84607 65029 5 18 61 21 32551 98030 3 14 41 35 31701 173587 1 20 70 95 71170 172684 5 30 112 102 101773 191381 5 20 71 212 101653 191276 0 26 90 141 81493 134043 9 20 69 54 55901 233406 6 27 85 117 109104 195304 6 18 47 145 114425 127619 5 27 50 50 36311 162810 6 22 76 80 70027 129100 2 19 60 87 73713 108715 0 15 35 78 40671 106469 3 19 72 86 89041 142069 8 28 88 82 57231 143937 2 20 66 139 78792 84256 5 17 58 75 59155 118807 11 25 81 70 55827 69471 6 20 63 25 22618 122433 5 25 91 66 58425 131122 1 20 50 89 65724 94763 0 22 75 99 56979 188780 3 25 85 98 72369 191467 3 20 75 104 79194 105615 6 23 70 48 202316 89318 1 22 78 81 44970 107335 0 21 61 64 49319 98599 1 18 55 44 36252 260646 0 25 60 104 75741 131876 5 22 83 36 38417 119291 2 25 38 120 64102 80953 0 8 27 58 56622 99768 0 21 62 27 15430 84572 5 22 82 84 72571 202373 1 21 79 56 67271 166790 0 30 59 46 43460 99946 1 23 80 119 99501 116900 1 20 36 57 28340 142146 2 24 88 139 76013 99246 4 21 63 51 37361 156833 1 20 73 85 48204 175078 4 20 71 91 76168 130533 0 20 76 79 85168 142339 2 20 67 142 125410 176789 0 23 66 149 123328 181379 7 33 123 96 83038 228548 7 19 65 198 120087 142141 6 27 87 61 91939 167845 0 25 77 145 103646 103012 0 20 37 26 29467 43287 4 19 64 49 43750 125366 4 15 22 68 34497 118372 0 21 35 145 66477 135171 0 22 61 82 71181 175568 0 24 80 102 74482 74112 0 19 54 52 174949 88817 0 20 60 56 46765 164767 4 23 87 80 90257 141933 0 27 75 99 51370 22938 0 1 0 11 1168 115199 0 20 54 87 51360 61857 4 11 30 28 25162 91185 0 27 66 67 21067 213765 1 22 56 150 58233 21054 0 0 0 4 855 167105 5 17 32 71 85903 31414 0 8 9 39 14116 178863 1 23 78 87 57637 126681 7 26 90 66 94137 64320 5 20 56 23 62147 67746 2 16 35 56 62832 38214 0 8 21 16 8773 90961 1 22 78 49 63785 181510 0 33 118 108 65196 116775 0 28 83 112 73087 223914 2 26 89 110 72631 185139 0 27 83 126 86281 242879 2 35 124 155 162365 139144 0 21 76 75 56530 75812 0 20 57 30 35606 178218 4 24 91 78 70111 246834 4 26 89 135 92046 50999 8 20 66 8 63989 223842 0 22 82 114 104911 93577 4 24 63 60 43448 155383 0 23 75 99 60029 111664 1 22 59 98 38650 75426 0 12 19 33 47261 243551 9 21 57 93 73586 136548 0 21 62 157 83042 173260 3 21 78 15 37238 185039 7 25 73 98 63958 67507 5 32 112 49 78956 139350 2 24 79 88 99518 172964 1 28 96 151 111436 0 9 0 0 0 0 14688 0 0 0 5 6023 98 0 0 0 0 0 455 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 128066 2 20 48 80 42564 176460 1 27 55 122 38885 0 0 0 0 0 0 203 0 0 0 0 0 7199 0 0 0 6 1644 46660 0 5 13 13 6179 17547 0 1 4 3 3926 73567 0 23 31 18 23238 969 0 0 0 0 0 101060 2 16 29 48 49288
Names of X columns:
Time_in_RFC Shared_compendiums Reviewed_compendiums Long_feedback Blogs Characters
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