Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
162687 0 48 21 20465 23975 39 201906 1 58 20 33629 85634 46 7215 0 0 0 1423 1929 0 146367 0 67 27 25629 36294 54 257045 0 83 31 54002 72255 93 524450 1 136 36 151036 189748 198 188294 1 65 23 33287 61834 42 195674 0 86 30 31172 68167 59 177020 0 62 30 28113 38462 49 325899 1 71 27 57803 101219 83 121844 2 50 24 49830 43270 49 203938 0 88 30 52143 76183 83 113213 0 61 22 21055 31476 39 220751 4 79 28 47007 62157 93 172905 4 56 18 28735 46261 31 156326 3 54 22 59147 50063 29 145178 0 81 37 78950 64483 104 89171 5 13 15 13497 2341 2 172624 0 74 34 46154 48149 46 39790 0 18 18 53249 12743 27 87927 0 31 15 10726 18743 16 241285 0 99 30 83700 97057 108 195820 1 38 25 40400 17675 36 146946 1 59 34 33797 33106 33 159763 1 54 21 36205 53311 46 207078 0 63 21 30165 42754 65 212394 0 66 25 58534 59056 80 201536 0 90 31 44663 101621 81 394662 0 72 31 92556 118120 69 217892 0 61 20 40078 79572 69 182286 0 61 28 34711 42744 37 181740 2 61 22 31076 65931 45 137978 4 53 17 74608 38575 62 255929 0 118 25 58092 28795 33 236489 1 73 25 42009 94440 77 0 0 0 0 0 0 0 230761 0 54 31 36022 38229 34 132807 3 54 14 23333 31972 44 157118 9 46 35 53349 40071 43 253254 0 83 34 92596 132480 117 269329 2 106 22 49598 62797 125 161273 0 44 34 44093 40429 49 107181 2 27 23 84205 45545 76 195891 1 64 24 63369 57568 81 139667 2 71 26 60132 39019 111 171101 2 44 23 37403 53866 61 81407 1 23 35 24460 38345 56 247563 0 78 24 46456 50210 54 239807 1 60 31 66616 80947 47 172743 8 73 30 41554 43461 55 48188 0 12 22 22346 14812 14 169355 0 104 23 30874 37819 44 315622 0 83 27 68701 102738 115 241518 0 57 30 35728 54509 57 195583 1 67 33 29010 62956 48 159913 8 44 12 23110 55411 40 220241 0 53 26 38844 50611 51 101694 1 26 26 27084 26692 32 157258 0 67 23 35139 60056 36 202536 10 36 38 57476 25155 47 173505 6 56 32 33277 42840 51 150518 0 52 21 31141 39358 37 141491 11 54 22 61281 47241 52 125612 3 57 26 25820 49611 42 166049 0 27 28 23284 41833 11 124197 0 58 33 35378 48930 47 195043 8 76 36 74990 110600 59 138708 2 93 25 29653 52235 82 116552 0 59 25 64622 53986 49 31970 0 5 21 4157 4105 6 258158 3 57 19 29245 59331 83 151184 1 42 12 50008 47796 56 135926 2 88 30 52338 38302 114 119629 1 53 21 13310 14063 46 171518 0 81 39 92901 54414 46 108949 2 35 32 10956 9903 2 183471 1 102 28 34241 53987 51 159966 0 71 29 75043 88937 96 93786 0 28 21 21152 21928 20 84971 0 34 31 42249 29487 57 88882 0 54 26 42005 35334 49 304603 0 49 29 41152 57596 51 75101 1 30 23 14399 29750 40 145043 0 57 25 28263 41029 40 95827 0 54 22 17215 12416 36 173924 0 38 26 48140 51158 64 241957 0 63 33 62897 79935 117 115367 0 58 24 22883 26552 40 118408 7 46 24 41622 25807 46 164078 0 46 21 40715 50620 61 158931 5 51 28 65897 61467 59 184139 1 87 28 76542 65292 94 152856 0 39 25 37477 55516 36 144014 0 28 15 53216 42006 51 62535 0 26 13 40911 26273 39 245196 0 52 36 57021 90248 62 199841 0 96 27 73116 61476 79 19349 0 13 1 3895 9604 14 247280 3 43 24 46609 45108 45 159408 0 42 31 29351 47232 43 72128 0 30 4 2325 3439 8 104253 0 59 21 31747 30553 41 151090 0 73 27 32665 24751 25 137382 1 39 23 19249 34458 22 87448 1 36 12 15292 24649 18 27676 0 2 16 5842 2342 3 165507 0 102 29 33994 52739 54 132148 1 30 26 13018 6245 6 0 0 0 0 0 0 0 95778 0 46 25 98177 35381 50 109001 0 25 21 37941 19595 33 158833 0 59 24 31032 50848 54 147690 1 60 21 32683 39443 63 89887 0 36 21 34545 27023 56 3616 0 0 0 0 0 0 0 0 0 0 0 0 0 199005 0 45 23 27525 61022 49 160930 0 79 33 66856 63528 90 177948 2 30 32 28549 34835 51 136061 0 43 23 38610 37172 29 43410 0 7 1 2781 13 1 184277 1 80 29 41211 62548 68 108858 0 32 20 22698 31334 29 141744 8 81 33 41194 20839 27 60493 3 3 12 32689 5084 4 19764 1 10 2 5752 9927 10 177559 3 47 21 26757 53229 47 140281 0 35 28 22527 29877 44 164249 0 54 35 44810 37310 53 11796 0 1 2 0 0 0 10674 0 0 0 0 0 0 151322 0 46 18 100674 50067 40 6836 0 0 1 0 0 0 174712 6 51 21 57786 47708 57 5118 0 5 0 0 0 0 40248 1 8 4 5444 6012 6 0 0 0 0 0 0 0 127628 0 38 29 28470 27749 24 88837 0 21 26 61849 47555 34 7131 1 0 0 0 0 0 9056 0 0 4 2179 1336 10 87957 1 18 19 8019 11017 16 144470 0 53 22 39644 55184 93 111408 1 17 22 23494 43485 28
Names of X columns:
timeRFC compshared blogged reviewedcomp characters seconds inclhyperlinks
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