Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
170650 65 26 99 95556 127 86621 54 20 77 54565 90 127843 58 27 102 63016 68 152526 99 25 96 79774 111 92389 41 17 49 31258 51 38138 0 16 64 52491 33 316392 112 20 76 91256 123 32750 1 18 67 22807 5 123444 40 19 72 77411 63 137034 60 22 83 48821 66 176816 68 30 113 52295 99 143205 74 40 151 63262 72 113286 38 26 88 50466 55 195452 77 36 123 62932 116 144513 62 31 118 38439 71 263581 126 41 157 70817 125 183271 85 24 92 105965 123 210763 74 27 103 73795 74 113853 78 19 72 82043 116 159968 100 30 115 74349 117 174585 79 31 115 82204 98 294675 77 26 92 55709 101 96213 42 15 56 37137 43 116390 83 33 132 70780 103 146342 103 28 107 55027 107 152647 71 27 102 56699 77 166661 77 21 78 65911 87 175505 100 27 103 56316 99 112485 45 21 81 26982 46 198790 101 30 114 54628 96 191822 87 30 115 96750 92 140267 44 33 118 53009 96 221991 97 35 133 64664 96 75339 32 26 99 36990 15 247985 89 27 103 85224 147 167351 71 25 93 37048 56 266609 70 30 114 59635 81 122024 50 20 76 42051 69 80964 30 8 27 26998 34 215183 90 24 92 63717 98 225469 78 25 96 55071 82 125382 48 28 104 40001 64 141437 57 23 84 54506 61 81106 31 21 79 35838 45 93125 30 21 57 50838 37 318668 72 26 99 86997 64 78800 20 26 82 33032 21 161048 84 30 113 61704 104 236367 94 34 129 117986 126 131108 79 30 110 56733 104 131096 72 18 78 55064 87 24188 8 4 12 5950 7 267003 67 31 114 84607 130 65029 21 18 67 32551 21 100147 30 14 52 31701 35 178549 70 21 80 71170 97 186965 89 37 138 101773 103 197266 87 24 92 101653 210 217300 116 29 105 81493 151 149594 54 24 91 55901 57 263413 112 31 118 109104 117 209228 94 21 77 114425 152 145699 51 31 122 36311 52 187197 52 26 99 70027 83 150752 38 24 92 73713 87 131218 65 18 70 40671 80 118697 64 21 81 89041 88 147913 66 29 107 57231 83 155015 99 24 92 68608 120 96487 100 21 77 59155 76 128780 56 30 115 55827 70 71972 22 20 76 22618 26 140266 51 30 115 58425 66 148454 62 24 92 65724 89 110655 97 26 100 56979 100 204822 99 27 103 72369 98 216052 77 24 92 79194 109 113421 58 23 87 202316 51 103660 77 26 100 44970 82 128390 52 25 95 49319 65 105502 48 18 69 36252 46 299359 111 30 115 75741 104 141493 28 25 95 38417 36 148356 86 27 55 64102 123 80953 49 8 28 56622 59 109237 24 21 79 15430 27 102104 46 26 99 72571 84 233139 44 24 92 67271 61 176507 49 30 98 43460 46 118217 108 27 103 99501 125 142694 44 24 89 28340 58 152193 110 25 95 76013 152 126500 30 21 78 37361 52 174710 82 24 92 48204 85 187772 49 24 92 76168 95 140903 64 24 92 85168 78 155350 75 24 83 125410 144 202077 123 24 92 123328 149 213875 104 40 151 83038 101 252952 106 22 83 120087 205 166981 73 31 118 91939 61 190562 110 26 98 103646 145 106351 30 20 76 29467 28 43287 13 19 71 43750 49 127493 69 15 57 34497 68 132143 75 22 83 66477 142 157469 82 25 95 71181 82 197727 108 28 108 74482 105 88077 28 23 91 174949 52 94968 83 25 99 46765 56 191753 52 26 100 90257 81 153332 90 32 119 51370 100 22938 12 1 0 1168 11 125927 87 24 91 51360 87 61857 23 11 32 25162 31 103749 57 31 117 21067 67 269909 93 26 99 58233 150 21054 4 0 0 855 4 174409 56 19 68 85903 75 31414 18 8 25 14116 39 200405 87 27 102 57637 88 139456 40 31 115 94137 67 78001 16 24 92 62147 24 82724 22 20 71 62832 58 38214 16 8 27 8773 16 91390 42 22 83 63785 49 197612 79 33 126 65196 109 137161 31 33 125 73087 124 251103 105 31 119 72631 115 209835 123 33 127 86281 128 269470 114 35 133 162365 159 139215 57 21 79 56530 75 77796 28 24 92 35606 30 197114 56 25 96 70111 83 291962 84 31 117 92046 135 56727 2 22 84 63989 8 254843 91 27 100 104911 115 105908 41 24 87 43448 60 170155 84 27 101 60029 99 136745 65 26 95 38650 98 86706 3 16 64 47261 36 251448 68 23 88 73586 93 152366 93 24 91 83042 158 173260 41 21 79 37238 16 212582 105 30 114 63958 100 87850 117 37 140 78956 49 148636 70 24 89 99518 89 185455 114 29 111 111436 153 0 0 0 0 0 0 14688 4 0 0 6023 5 98 0 0 0 0 0 455 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 137891 42 20 74 42564 80 201052 97 31 123 38885 122 0 0 0 0 0 0 203 0 0 0 0 0 7199 7 0 0 1644 6 46660 12 5 15 6179 13 17547 0 1 4 3926 3 73567 37 23 82 23238 18 969 0 0 0 0 0 106662 39 16 54 49288 49
Names of X columns:
Total_time_RFC Blogged_Comp Feedback reviews characters Hyperlinks
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