Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
157382 48 18 20465 23975 0 168465 45 20 33629 85634 1 7215 0 0 1423 1929 0 122259 49 26 25629 36294 0 221399 76 30 54002 72255 0 454489 118 36 151036 189748 1 134379 42 23 33287 61834 1 150416 62 30 31172 68167 0 121391 48 30 28113 38462 0 275326 67 26 57803 101219 1 121593 50 24 49830 43270 2 172071 71 30 52143 76183 0 86249 41 21 21055 31476 0 201902 77 25 47007 62157 4 144113 45 17 28735 46261 4 144677 54 19 59147 50063 3 134153 75 33 78950 64483 0 64149 0 15 13497 2341 5 122294 54 34 46154 48149 0 27918 13 18 53249 12743 0 52197 16 15 10726 18743 0 191463 78 27 83700 97057 0 176034 35 25 40400 17675 0 98629 38 34 33797 33106 1 143546 50 21 36205 53311 1 139780 39 21 30165 42754 0 174181 58 25 58534 59056 0 163773 70 28 44663 101621 0 312831 55 28 92556 118120 0 184024 52 20 40078 79572 0 151621 50 28 34711 42744 0 164516 54 20 31076 65931 2 120414 53 17 74608 38575 4 214975 76 25 58092 28795 0 200609 54 24 42009 94440 1 0 0 0 0 0 0 191923 46 27 36022 38229 0 93107 44 14 23333 31972 3 129419 35 32 53349 40071 9 233497 82 31 92596 132480 0 178228 73 21 49598 62797 2 126602 31 34 44093 40429 0 94332 25 23 84205 45545 2 164183 57 24 63369 57568 1 95704 44 22 60132 39019 2 139901 40 22 37403 53866 2 81293 23 35 24460 38345 1 189007 63 21 46456 50210 0 173779 43 31 66616 80947 1 146552 62 26 41554 43461 7 48188 12 22 22346 14812 0 113870 67 21 30874 37819 0 266451 60 27 68701 102738 0 229437 55 26 35728 54509 0 174876 53 33 29010 62956 1 119070 35 11 23110 55411 6 186704 50 26 38844 50611 0 72559 25 26 27084 26692 0 111940 47 23 35139 60056 0 166226 30 38 57476 25155 10 135901 50 29 33277 42840 6 102141 36 19 31141 39358 0 115753 43 19 61281 47241 11 102194 44 24 25820 49611 3 148531 25 26 23284 41833 0 94982 38 29 35378 48930 0 178613 68 36 74990 110600 8 128907 83 25 29653 52235 2 102378 48 24 64622 53986 0 31970 5 21 4157 4105 0 204812 53 19 29245 59331 3 104972 36 12 50008 47796 1 95276 62 28 52338 38302 2 101560 46 21 13310 14063 1 144193 67 34 92901 54414 0 71921 2 32 10956 9903 2 126905 64 27 34241 53987 1 140303 59 28 75043 88937 0 60138 16 21 21152 21928 0 84971 34 31 42249 29487 0 80420 54 26 42005 35334 0 244190 39 29 41152 57596 0 56252 26 23 14399 29750 0 97181 37 25 28263 41029 0 50913 17 22 17215 12416 0 143910 32 26 48140 51158 0 218900 55 33 62897 79935 0 90772 50 22 22883 26552 0 90385 39 24 41622 25807 6 136220 30 21 40715 50620 0 115572 45 28 65897 61467 5 139075 66 23 76542 65292 1 148950 39 25 37477 55516 0 124626 27 15 53216 42006 0 49176 22 13 40911 26273 0 215480 45 36 57021 90248 0 182328 95 24 73116 61476 0 19349 13 1 3895 9604 0 183873 26 24 46609 45108 3 146020 40 31 29351 47232 0 51201 13 4 2325 3439 0 58280 41 20 31747 30553 0 115944 51 23 32665 24751 0 101515 27 23 19249 34458 1 72904 30 12 15292 24649 0 27676 2 16 5842 2342 0 131173 79 29 33994 52739 0 89920 12 10 13018 6245 0 0 0 0 0 0 0 85610 46 25 98177 35381 0 106742 25 21 37941 19595 0 126825 49 23 31032 50848 0 109807 52 21 32683 39443 0 71894 36 21 34545 27023 0 3616 0 0 0 0 0 0 0 0 0 0 0 154806 35 23 27525 61022 0 136333 68 29 66856 63528 0 147766 26 28 28549 34835 1 113245 36 23 38610 37172 0 43410 7 1 2781 13 0 152455 67 25 41211 62548 1 88874 30 17 22698 31334 0 111924 55 29 41194 20839 8 60373 3 12 32689 5084 3 19764 10 2 5752 9927 1 125760 46 20 26757 53229 2 108685 23 25 22527 29877 0 141868 48 29 44810 37310 0 11796 1 2 0 0 0 10674 0 0 0 0 0 131263 33 18 100674 50067 0 6836 0 1 0 0 0 153278 48 21 57786 47708 5 5118 5 0 0 0 0 40248 8 4 5444 6012 1 0 0 0 0 0 0 100798 25 25 28470 27749 0 84315 21 26 61849 47555 0 7131 0 0 0 0 1 8812 0 4 2179 1336 0 63952 15 17 8019 11017 1 120111 47 21 39644 55184 0 94127 17 22 23494 43485 1
Names of X columns:
time blogs reviews CWcharacters CWseconds shared
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