Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
11 236496 61 85 34 131 124252 10 130631 58 58 30 117 98956 12 198514 62 62 38 146 98073 11 189326 94 108 34 132 106816 12 137449 43 55 25 80 41449 10 65295 27 8 31 117 76173 10 439387 103 134 29 112 177551 11 33186 19 1 18 67 22807 10 174859 50 63 30 116 126938 10 186657 38 77 29 107 61680 12 261949 95 86 38 140 72117 10 190794 94 93 49 186 79738 11 138866 57 44 33 109 57793 11 296878 65 106 46 159 91677 10 192648 71 63 38 146 64631 12 333348 161 160 52 201 106385 10 242212 57 104 32 124 161961 10 263451 130 86 35 131 112669 12 150733 47 92 25 96 114029 10 223226 67 119 42 163 124550 11 240028 63 107 40 151 105416 10 384138 86 86 35 128 72875 10 156540 34 50 25 89 81964 12 148421 43 92 46 184 104880 11 176502 96 123 36 136 76302 12 191441 105 81 35 134 96740 11 249735 120 93 38 146 93071 12 236812 76 113 35 130 78912 11 142329 45 52 28 105 35224 10 259667 53 113 37 142 90694 11 228871 64 109 40 155 125369 12 176054 66 44 42 154 80849 11 286683 79 123 44 169 104434 10 87485 33 38 33 125 65702 12 322865 82 111 35 135 108179 12 247013 50 77 37 139 63583 11 340093 103 92 37 139 95066 12 191653 72 74 32 124 62486 10 114673 31 33 17 55 31081 11 284210 160 105 34 131 94584 10 284195 72 108 33 125 87408 11 155363 59 66 35 128 68966 12 174198 65 69 32 107 88766 10 142986 48 62 35 130 57139 10 140319 73 50 45 73 90586 10 392666 132 91 34 125 109249 11 78800 42 20 26 82 33032 12 201970 69 101 45 173 96056 12 302674 99 129 44 169 146648 11 164733 50 93 40 145 80613 11 194221 68 89 33 134 87026 10 24188 24 8 4 12 5950 11 340411 274 79 41 151 131106 12 65029 17 21 18 67 32551 11 101097 64 30 14 52 31701 12 243889 45 86 33 121 91072 10 273003 74 116 49 186 159803 12 282220 160 106 32 120 143950 10 273495 118 127 37 135 112368 10 214872 74 75 32 123 82124 12 333165 122 138 41 158 144068 12 260981 105 114 25 90 162627 11 184474 87 55 38 149 55062 12 222366 76 67 34 131 95329 11 205675 60 43 33 125 105612 10 201345 60 88 28 110 62853 11 163043 110 67 31 121 125976 10 204250 128 75 40 151 79146 12 197760 66 114 32 123 108461 10 127260 57 119 25 92 99971 10 216092 59 86 42 162 77826 12 73566 32 22 23 88 22618 11 213198 67 67 42 163 84892 11 177949 48 77 34 120 92059 10 148698 49 105 34 132 77993 11 300103 69 119 38 144 104155 10 251437 78 88 32 124 109840 10 191971 99 75 37 140 238712 11 154651 53 112 34 132 67486 12 155473 56 66 33 122 68007 11 132672 41 58 25 97 48194 10 376465 99 132 40 155 134796 11 145869 65 30 26 99 38692 11 223666 85 100 40 106 93587 10 80953 25 49 8 28 56622 11 130789 46 26 27 101 15986 12 135042 47 67 32 120 113402 10 300074 152 57 33 127 97967 12 271757 93 95 50 178 74844 12 150949 95 139 37 141 136051 10 216802 77 70 33 122 50548 10 197389 67 134 34 127 112215 11 156583 56 37 28 102 59591 12 222599 65 98 32 124 59938 10 261601 70 58 32 124 137639 10 178489 35 78 32 124 143372 12 200657 43 88 31 111 138599 12 259084 67 142 35 129 174110 10 302789 129 127 52 199 135062 12 342025 98 139 27 102 175681 11 246440 104 108 45 174 130307 12 251306 56 128 37 141 139141 12 159965 156 62 32 122 44244 11 43287 14 13 19 71 43750 10 172212 67 89 22 81 48029 10 181781 117 83 35 131 95216 12 227681 43 116 36 139 92288 12 260464 80 157 36 137 94588 11 106288 54 28 23 91 197426 11 109632 76 83 36 142 151244 12 268905 58 72 36 133 139206 10 266568 77 134 42 155 106271 12 23623 11 12 1 0 1168 11 152474 65 106 32 123 71764 10 61857 25 23 11 32 25162 11 144889 43 83 40 149 45635 11 330910 95 120 34 128 101817 11 21054 16 4 0 0 855 10 223718 44 71 27 99 100174 10 31414 19 18 8 25 14116 10 259747 103 98 35 132 85008 12 190495 55 66 40 151 124254 11 154984 73 44 40 151 105793 11 112933 45 29 28 103 117129 12 38214 34 16 8 27 8773 11 158671 33 56 35 131 94747 11 299775 68 112 45 170 107549 10 172783 54 46 43 165 97392 10 348678 69 129 41 159 126893 11 266701 89 139 43 167 118850 10 358933 99 136 47 178 234853 11 172464 31 66 35 135 74783 10 94381 35 42 32 118 66089 11 243875 274 70 36 140 95684 11 382487 153 97 42 158 139537 12 111853 39 49 35 132 144253 10 334926 117 113 37 136 153824 10 147979 72 55 34 123 63995 11 216638 44 100 36 134 84891 10 192853 71 80 36 129 61263 11 173710 103 29 27 107 106221 10 336678 103 95 33 128 113587 10 212961 75 114 35 129 113864 12 173260 63 41 21 79 37238 10 271773 89 128 40 154 119906 12 127096 51 142 47 180 135096 11 203606 73 88 33 122 151611 12 230177 87 132 39 144 144645 10 1 0 0 0 0 0 10 14688 10 4 0 0 6023 11 98 1 0 0 0 0 12 455 2 0 0 0 0 12 0 0 0 0 0 0 10 0 0 0 0 0 0 11 195765 75 56 33 120 77457 10 306514 117 111 42 168 62464 12 0 0 0 0 0 0 10 203 4 0 0 0 0 10 7199 5 7 0 0 1644 10 46660 20 12 5 15 6179 11 17547 5 0 1 4 3926 11 105044 37 37 38 133 42087 12 969 2 0 0 0 0 10 165838 56 46 28 101 87656
Names of X columns:
Maand Total_Time_spent_in_RFC Number_of_Logins Total_Number_of_Blogged_Computations Total_Number_of_Reviewed_Compendiums Total_Number_of_Feedback_Messages_PeerReviews Total_number_of_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