Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
2001 100 95 102 103 91 99 101 91 114 101 103 85 2001 94 97 99 117 85 97 97 87 99 99 97 94 2001 105 97 108 115 110 113 108 103 98 104 110 107 2001 95 97 92 74 90 100 95 97 91 99 97 98 2001 103 103 99 74 103 105 99 96 111 101 103 111 2001 103 101 102 81 119 109 101 105 104 102 106 115 2001 100 96 87 86 76 91 92 74 100 93 89 76 2001 108 94 71 114 93 89 92 87 108 97 85 100 2001 108 97 105 102 105 105 100 105 113 91 100 103 2001 120 101 115 85 92 120 106 118 113 97 106 117 2001 112 77 103 63 75 107 99 102 114 94 95 101 2001 102 93 75 61 61 84 84 101 109 90 74 73 2002 105 45 97 87 80 101 106 86 116 105 94 84 2002 101 48 95 97 85 105 101 83 102 103 90 90 2002 108 52 99 88 94 119 113 92 107 112 99 105 2002 107 49 100 67 78 114 110 87 111 114 100 111 2002 109 53 92 59 92 114 103 94 122 111 96 110 2002 110 60 94 63 90 119 107 94 123 106 102 116 2002 111 51 89 86 72 99 98 75 108 112 88 85 2002 110 42 67 99 77 91 90 85 115 102 78 92 2002 117 56 109 85 76 121 105 104 120 103 99 117 2002 130 51 113 74 89 128 116 109 117 105 107 119 2002 114 53 106 55 55 112 102 121 115 101 93 100 2002 113 55 78 54 47 93 88 124 116 101 74 71 2003 110 44 102 81 91 108 114 88 118 117 96 82 2003 107 51 97 88 85 107 104 86 98 109 99 90 2003 110 52 96 75 89 115 111 98 121 120 103 109 2003 113 54 99 55 90 121 111 94 118 115 102 112 2003 106 50 86 47 72 112 102 102 120 107 96 103 2003 118 57 92 54 83 123 106 96 111 110 106 116 2003 118 49 86 71 72 101 104 79 117 110 95 89 2003 114 41 62 79 75 87 94 95 110 105 82 91 2003 121 58 105 77 85 124 116 106 107 116 109 121 2003 130 63 108 57 81 125 118 116 115 116 114 123 2003 115 54 96 40 69 111 101 101 106 111 95 98 2003 118 55 80 44 68 98 101 108 115 120 85 81 2004 111 56 95 67 94 102 109 92 112 111 98 84 2004 108 56 94 75 97 105 108 89 106 115 100 92 2004 124 70 108 75 102 128 124 109 106 125 119 116 2004 115 69 97 49 94 125 117 97 114 116 109 112 2004 113 57 89 37 89 116 104 99 109 113 99 106 2004 128 68 107 50 114 131 121 110 100 122 119 131 2004 117 53 87 63 82 98 101 76 105 123 94 83 2004 119 48 70 76 96 89 105 91 100 117 88 98 2004 130 61 111 69 104 133 121 105 104 136 116 120 2004 126 62 105 49 88 114 116 103 112 121 109 121 2004 125 58 99 40 85 113 106 108 97 120 103 107 2004 131 51 84 39 87 104 105 122 107 126 93 89 2005 116 51 87 54 86 108 107 92 104 116 100 81 2005 109 48 92 71 89 106 101 95 98 108 102 90 2005 124 59 98 68 105 117 113 106 100 117 113 103 2005 119 54 95 43 83 123 109 98 97 113 112 117 2005 119 56 85 42 87 114 103 110 81 113 104 110 2005 131 60 100 48 112 132 116 107 73 126 118 130 2005 111 51 79 58 97 92 98 69 89 114 94 79 2005 125 51 66 76 89 94 99 95 96 113 95 101 2005 132 56 105 57 109 121 117 114 97 112 121 123 2005 127 53 96 44 88 114 107 104 98 113 114 111 2005 132 53 103 40 91 116 107 110 89 116 114 109 2005 131 48 83 36 79 98 102 112 98 112 99 89 2006 122 50 91 60 115 112 103 92 91 119 112 87 2006 113 49 95 73 119 109 101 97 86 117 111 95 2006 134 55 109 71 125 133 117 114 97 125 126 119 2006 119 50 92 45 96 118 103 93 102 113 112 110 2006 129 57 99 45 117 132 106 115 80 120 124 124 2006 131 65 110 48 120 134 111 112 71 114 127 133 2006 117 53 88 60 104 97 94 76 91 114 101 84 2006 131 42 73 72 121 100 101 101 102 118 102 105 2006 132 56 111 63 127 128 111 119 91 117 126 128 2006 141 58 112 32 118 135 114 118 94 121 129 127 2006 138 54 111 34 108 131 110 120 53 115 122 120 2006 129 51 84 24 89 107 100 120 77 117 100 93 2007 127 59 102 65 137 122 104 99 70 119 122 98 2007 121 49 102 73 142 121 106 103 65 115 120 106 2007 139 61 114 62 137 141 116 118 89 126 137 122 2007 129 52 99 32 123 125 104 103 70 118 124 116 2007 131 58 100 31 126 130 107 114 78 118 130 122 2007 136 66 110 37 148 159 113 116 78 115 137 134 2007 129 62 93 48 116 111 104 84 73 122 114 88 2007 133 45 77 54 139 110 103 106 83 117 109 110 2007 136 52 108 44 151 133 109 117 74 106 126 122 2007 151 59 120 41 124 135 123 125 102 111 141 135 2007 145 58 106 32 109 119 110 123 54 114 130 116 2007 134 45 78 31 112 94 94 119 79 114 98 85 2008 136 65 100 49 136 118 114 100 86 125 130 106 2008 129 64 102 54 136 115 110 100 87 125 130 115 2008 129 69 97 44 139 114 110 103 79 120 125 111 2008 139 71 101 31 138 131 113 104 64 121 136 133 2008 133 63 89 24 142 117 105 99 70 111 124 124 2008 133 74 93 37 144 123 108 101 75 124 133 131 2008 137 63 89 38 147 106 101 73 72 120 121 97 2008 127 52 62 42 201 89 95 86 83 126 102 97 2008 144 73 96 36 196 116 112 110 74 116 131 131 2008 150 67 95 31 170 116 113 115 82 117 130 127 2008 132 63 80 24 177 97 96 101 78 106 106 101 2008 139 70 67 29 190 82 93 112 77 102 93 88 2009 123 66 71 38 138 92 91 89 77 106 100 76 2009 122 60 73 44 133 90 91 93 72 97 99 87 2009 136 66 81 33 131 99 101 103 76 108 112 110 2009 133 68 77 23 110 99 98 91 75 99 109 102 2009 127 68 68 19 124 89 94 88 69 101 102 99 2009 139 81 77 27 150 106 102 93 67 106 116 117 2009 131 75 73 29 163 84 96 65 68 105 103 83 2009 132 55 54 34 138 78 92 82 73 103 91 90 2009 136 79 85 26 133 101 106 102 69 102 119 116 2009 142 52 86 28 123 100 105 102 76 107 117 117 2009 133 56 79 18 107 96 97 122 67 100 106 96 2009 132 66 67 24 122 80 94 105 69 101 92 73 2010 121 66 72 29 141 87 95 83 68 105 102 66 2010 124 59 76 38 136 90 95 85 64 118 104 73 2010 145 78 90 33 140 113 114 102 69 129 124 114 2010 135 70 84 22 109 105 107 86 67 124 118 107 2010 128 65 75 20 109 100 100 84 71 128 109 102 2010 142 88 90 31 128 116 112 93 58 129 129 125 2010 130 75 77 27 162 89 101 64 57 128 105 80 2010 131 62 60 28 147 87 100 81 69 125 100 95 2010 141 85 92 28 148 111 111 100 76 125 125 120 2010 140 82 88 25 103 110 107 96 74 130 116 117 2010 142 83 83 21 102 104 105 93 77 125 112 99 2010 140 78 69 24 100 85 104 102 81 122 97 64 2011 132 81 73 28 117 96 106 78 77 129 107 82 2011 132 75 78 33 139 99 105 92 64 124 114 97 2011 151 91 92 31 122 117 114 99 67 144 130 121
Names of X columns:
Jaar Voedingsmiddelen Tabaksproducten Textiel Kleding Leer Hout Papier Uitgeverijen Cokes Chemische Rubber Nietmetaalhoudende
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