Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
'4.35' 0 1 22 23 48 23 12 '12.7' 0 1 22 22 50 16 45 '18.1' 0 1 22 21 150 33 37 '17.85' 0 1 20 25 154 32 37 '16.6' 1 0 19 30 109 37 108 '12.6' 1 1 20 17 68 14 10 '17.1' 0 1 22 27 194 52 68 '19.1' 0 0 21 23 158 75 72 '16.1' 0 1 21 23 159 72 143 '13.35' 0 0 21 18 67 15 9 '18.4' 0 0 21 18 147 29 55 '14.7' 0 1 21 23 39 13 17 '10.6' 0 1 21 19 100 40 37 '12.6' 0 1 21 15 111 19 27 '16.2' 0 1 22 20 138 24 37 '13.6' 0 1 24 16 101 121 58 '18.9' 1 1 21 24 131 93 66 '14.1' 0 1 22 25 101 36 21 '14.5' 0 1 20 25 114 23 19 '16.15' 0 0 21 19 165 85 78 '14.75' 0 1 24 19 114 41 35 '14.8' 0 1 25 16 111 46 48 '12.45' 0 1 22 19 75 18 27 '12.65' 0 1 21 19 82 35 43 '17.35' 0 1 21 23 121 17 30 '8.6' 0 1 22 21 32 4 25 '18.4' 0 0 23 22 150 28 69 '16.1' 0 1 24 19 117 44 72 '11.6' 1 1 20 20 71 10 23 '17.75' 0 1 22 20 165 38 13 '15.25' 0 1 25 3 154 57 61 '17.65' 0 1 22 23 126 23 43 '15.6' 0 0 22 14 138 26 22 '16.35' 0 0 21 23 149 36 51 '17.65' 0 0 21 20 145 22 67 '13.6' 0 1 21 15 120 40 36 '11.7' 0 0 22 13 138 18 21 '14.35' 0 0 22 16 109 31 44 '14.75' 0 0 22 7 132 11 45 '18.25' 0 1 21 24 172 38 34 '9.9' 0 0 22 17 169 24 36 16 0 1 23 24 114 37 72 '18.25' 0 1 21 24 156 37 39 '16.85' 0 0 21 19 172 22 43 '14.6' 1 1 21 25 68 15 25 '13.85' 1 1 19 20 89 2 56 '18.95' 0 1 21 28 167 43 80 '15.6' 0 0 21 23 113 31 40 '14.85' 1 0 19 27 115 29 73 '11.75' 1 0 18 18 78 45 34 '18.45' 1 0 19 28 118 25 72 '15.9' 1 1 21 21 87 4 42 '17.1' 0 0 22 19 173 31 61 '16.1' 0 1 22 23 2 -4 23 '19.9' 1 0 19 27 162 66 74 '10.95' 1 1 20 22 49 61 16 '18.45' 1 0 19 28 122 32 66 '15.1' 1 1 21 25 96 31 9 15 1 0 19 21 100 39 41 '11.35' 1 0 20 22 82 19 57 '15.95' 1 1 21 28 100 31 48 '18.1' 1 0 19 20 115 36 51 '14.6' 1 1 21 29 141 42 53 '15.4' 0 1 21 25 165 21 29 '15.4' 0 1 21 25 165 21 29 '17.6' 1 1 19 20 110 25 55 '13.35' 0 1 25 20 118 32 54 '19.1' 0 0 21 16 158 26 43 '15.35' 1 1 20 20 146 28 51 '7.6' 0 0 25 20 49 32 20 '13.4' 1 0 19 23 90 41 79 '13.9' 1 0 20 18 121 29 39 '19.1' 0 1 22 25 155 33 61 '15.25' 1 0 19 18 104 17 55 '12.9' 1 1 20 19 147 13 30 '16.1' 1 0 19 25 110 32 55 '17.35' 1 0 19 25 108 30 22 '13.15' 1 0 18 25 113 34 37 '12.15' 1 0 19 24 115 59 2 '12.6' 1 1 21 19 61 13 38 '10.35' 1 1 19 26 60 23 27 '15.4' 1 1 20 10 109 10 56 '9.6' 1 1 20 17 68 5 25 '18.2' 1 0 19 13 111 31 39 '13.6' 1 0 19 17 77 19 33 '14.85' 1 1 22 30 73 32 43 '14.75' 0 0 21 25 151 30 57 '14.1' 1 0 19 4 89 25 43 '14.9' 1 0 19 16 78 48 23 '16.25' 1 0 19 21 110 35 44 '19.25' 0 1 23 23 220 67 54 '13.6' 1 1 19 22 65 15 28 '13.6' 0 0 20 17 141 22 36 '15.65' 1 0 19 20 117 18 39 '12.75' 0 1 22 20 122 33 16 '14.6' 1 0 19 22 63 46 23 '9.85' 0 1 25 16 44 24 40 '12.65' 1 1 19 23 52 14 24 '11.9' 1 1 20 16 62 23 29 '19.2' 1 0 19 0 131 12 78 '16.6' 1 1 19 18 101 38 57 '11.2' 1 1 20 25 42 12 37 '15.25' 0 1 20 23 152 28 27 '11.9' 0 0 21 12 107 41 61 '13.2' 1 0 19 18 77 12 27 '16.35' 0 0 21 24 154 31 69 '12.4' 0 1 23 11 103 33 34 '15.85' 1 1 19 18 96 34 44 '14.35' 0 0 21 14 154 41 21 '18.15' 0 1 22 23 175 21 34 '11.15' 1 1 20 24 57 20 39 '15.65' 1 0 18 29 112 44 51 '17.75' 0 0 21 18 143 52 34 '7.65' 1 0 20 15 49 7 31 '12.35' 0 1 21 29 110 29 13 '15.6' 0 1 21 16 131 11 12 '19.3' 0 0 21 19 167 26 51 '15.2' 1 0 19 22 56 24 24 '17.1' 0 0 21 16 137 7 19 '15.6' 1 1 19 23 86 60 30 '18.4' 0 1 21 23 121 13 81 '19.05' 0 0 21 19 149 20 42 '18.55' 0 0 22 4 168 52 22 '19.1' 0 0 21 20 140 28 85 '13.1' 1 1 22 24 88 25 27 '12.85' 0 1 22 20 168 39 25 '9.5' 0 1 22 4 94 9 22 '4.5' 0 1 22 24 51 19 19 '11.85' 1 0 21 22 48 13 14 '13.6' 0 1 22 16 145 60 45 '11.7' 0 1 23 3 66 19 45 '12.4' 1 1 19 15 85 34 28 '13.35' 0 0 22 24 109 14 51 '11.4' 1 0 21 17 63 17 41 '14.9' 1 1 19 20 102 45 31 '19.9' 1 0 19 27 162 66 74 '17.75' 0 1 20 23 128 24 24 '11.2' 1 1 20 26 86 48 19 '14.6' 1 1 18 23 114 29 51 '17.6' 0 0 21 17 164 -2 73 '14.05' 0 1 21 20 119 51 24 '16.1' 0 0 20 22 126 2 61 '13.35' 0 1 20 19 132 24 23 '11.85' 0 1 21 24 142 40 14 '11.95' 0 0 21 19 83 20 54 '14.75' 1 1 19 23 94 19 51 '15.15' 1 0 19 15 81 16 62 '13.2' 0 1 21 27 166 20 36 '16.85' 1 0 19 26 110 40 59 '7.85' 1 1 19 22 64 27 24 '7.7' 0 0 24 22 93 25 26 '12.6' 1 0 19 18 104 49 54 '7.85' 1 1 19 15 105 39 39 '10.95' 1 1 20 22 49 61 16 '12.35' 1 0 19 27 88 19 36 '9.95' 1 1 19 10 95 67 31 '14.9' 1 1 19 20 102 45 31 '16.65' 1 0 19 17 99 30 42 '13.4' 1 1 19 23 63 8 39 '13.95' 1 0 19 19 76 19 25 '15.7' 1 0 20 13 109 52 31 '16.85' 1 1 20 27 117 22 38 '10.95' 1 1 19 23 57 17 31 '15.35' 1 0 21 16 120 33 17 '12.2' 1 1 19 25 73 34 22 '15.1' 1 0 19 2 91 22 55 '17.75' 1 0 19 26 108 30 62 '15.2' 1 1 21 20 105 25 51 '14.6' 0 0 22 23 117 38 30 '16.65' 1 0 19 22 119 26 49 '8.1' 1 1 19 24 31 13 16
Names of X columns:
TOT programma gender age NUMERACYTOT LFM PRH CH
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, signif(mysum$coefficients[i,1],6), 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,signif(mysum$coefficients[i,1],6)) a<-table.element(a, signif(mysum$coefficients[i,2],6)) a<-table.element(a, signif(mysum$coefficients[i,3],4)) a<-table.element(a, signif(mysum$coefficients[i,4],6)) a<-table.element(a, signif(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, signif(sqrt(mysum$r.squared),6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a, signif(mysum$r.squared,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a, signif(mysum$adj.r.squared,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[1],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF numerator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[2],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (DF denominator)',1,TRUE) a<-table.element(a, signif(mysum$fstatistic[3],6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'p-value',1,TRUE) a<-table.element(a, signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6)) 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, signif(mysum$sigma,6)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a, signif(sum(myerror*myerror),6)) 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,signif(x[i],6)) a<-table.element(a,signif(x[i]-mysum$resid[i],6)) a<-table.element(a,signif(mysum$resid[i],6)) 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,signif(gqarr[mypoint-kp3+1,1],6)) a<-table.element(a,signif(gqarr[mypoint-kp3+1,2],6)) a<-table.element(a,signif(gqarr[mypoint-kp3+1,3],6)) 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,signif(numsignificant1,6)) a<-table.element(a,signif(numsignificant1/numgqtests,6)) 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,signif(numsignificant5,6)) a<-table.element(a,signif(numsignificant5/numgqtests,6)) 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,signif(numsignificant10,6)) a<-table.element(a,signif(numsignificant10/numgqtests,6)) 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