Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
10 72 36 32 68 56 43 89 56 20 70 30 50 70 60 30 60 50 40 90 70 70 90 70 30 95 70 67 81 61 63 95 68 54 97 67 38 80 46 85 75 63 30 80 60 61 40 40 40 69 67 16 92 83 29 49 50 45 39 41 42 61 37 0 80 10 50 80 50 0 90 50 30 90 30 70 100 80 30 100 70 39 86 61 67 80 59 44 96 51 70 100 80 80 81 81 70 100 81 65 40 65 45 55 70 30 70 60 5 100 20 90 100 90 5 100 90 30 75 60 45 75 50 30 85 45 50 83 69 78 70 85 62 89 62 90 100 91 100 100 100 91 100 100 45 77 62 60 61 60 41 74 51 75 55 90 70 83 90 73 94 72 76 97 80 64 90 61 60 96 59 15 60 25 40 60 45 20 70 30 10 40 NA 44 44 82 4 85 73 NA 100 NA 90 90 90 NA 90 90 60 100 70 90 100 100 60 100 90 67 59 63 NA 82 54 62 81 NA 60 65 60 68 80 55 60 71 80 80 91 77 92 88 86 76 85 84 70 100 70 90 100 95 65 100 95 70 85 76 82 83 76 60 62 58 87 62 78 83 75 75 88 86 76 27 68 61 59 55 59 16 60 57 65 75 65 55 75 60 65 80 55 56 80 80 66 80 80 35 80 65 82 80 30 50 70 70 70 100 70 30 34 23 18 100 29 21 100 28 38 42 100 61 60 92 60 100 57 56 94 94 NA 95 89 100 96 89 70 85 75 85 95 85 65 95 85 80 95 80 90 90 90 80 100 80 71 90 71 65 90 65 65 90 65 50 80 60 60 80 70 60 80 59 31 61 37 65 76 70 31 90 67 40 65 55 60 65 56 55 65 60 71 73 79 72 78 74 74 98 93 71 81 38 20 70 44 32 38 56 10 40 20 30 60 50 10 90 50 20 90 40 80 65 60 20 90 60 40 95 70 45 100 90 40 100 85 55 67 60 67 65 65 55 70 67 80 90 85 100 90 90 70 100 95 80 90 70 80 90 80 80 95 80 72 90 78 65 90 72 50 88 62 60 85 75 80 80 80 55 85 80 29 91 49 91 91 91 29 91 91 70 100 70 100 100 100 70 100 100 60 60 70 66 90 78 50 100 71 63 100 70 65 80 81 60 100 63 70 90 70 70 100 70 60 100 60 38 85 48 78 88 61 27 95 53 40 81 59 100 61 100 38 80 100 80 80 80 70 90 80 70 100 80 24 45 38 45 58 49 15 70 50 40 90 50 40 90 50 40 100 40 47 93 65 74 88 63 37 93 54 70 75 50 80 90 75 NA 100 60 70 80 70 60 80 70 10 100 59 75 85 65 75 85 65 75 85 75 60 70 70 70 60 75 60 75 70 65 80 70 75 95 90 55 100 75 91 96 90 90 100 91 91 100 91 68 62 43 69 61 69 29 50 66 80 82 NA 70 NA 70 NA 80 70 90 50 90 50 80 90 50 90 50 20 75 40 50 90 75 10 100 50 61 59 59 66 75 77 57 88 74 13 78 31 66 85 81 45 90 79 80 95 80 65 95 75 70 99 70 40 70 54 64 78 65 38 90 57 70 80 70 80 90 85 70 90 85 39 75 40 60 80 60 40 100 60 93 95 65 93 100 94 61 100 96 10 70 15 40 30 45 15 88 10 25 90 40 80 70 70 25 100 40 56 59 58 65 67 62 54 71 58 18 16 14 38 35 34 36 95 34 60 60 70 70 100 80 50 100 70 74 87 87 82 96 90 68 97 80 35 80 43 57 74 55 14 93 60 NA 70 70 70 70 70 NA 70 70 71 80 71 70 80 71 68 90 71 100 100 100 100 100 100 100 100 100 64 100 78 74 100 74 74 100 74 50 81 32 43 74 61 59 96 56 40 49 52 52 59 58 50 72 51 35 75 60 60 35 60 60 75 35 60 70 NA 80 80 90 60 81 64 70 91 71 71 91 71 70 91 70 55 75 53 68 75 75 45 82 75 65 85 65 80 82 70 60 84 70 30 84 50 81 NA 88 21 99 47 25 100 20 65 100 65 0 100 50 80 90 80 90 90 90 65 100 90 26 87 39 51 50 47 33 73 53 78 86 80 68 90 69 70 100 69 10 60 30 10 60 10 20 70 10 70 100 65 81 100 84 60 100 83 NA 78 77 85 80 83 84 81 79 65 80 35 55 65 60 65 85 65 80 90 60 85 100 91 60 100 90 60 81 72 65 72 68 53 90 44 74 71 63 67 98 70 71 93 67 49 92 60 48 93 56 32 97 45 70 NA 60 40 45 66 70 90 80 66 50 71 60 88 100 60 100 91 65 81 66 65 82 72 60 82 67 65 90 65 60 90 60 NA 90 50 40 90 75 75 100 80 50 100 65 40 85 40 65 75 70 25 85 60 20 80 30 80 100 50 20 100 30 90 95 70 100 100 100 80 100 100 48 100 59 98 80 91 53 88 89 25 79 57 65 71 64 39 84 59 35 80 55 68 71 70 53 76 69 40 50 45 50 60 60 39 80 54 77 70 50 82 100 84 70 95 78 70 81 59 65 80 71 60 86 66 82 91 87 72 85 89 77 89 84 80 100 80 80 100 80 80 100 80 52 57 62 64 61 59 50 67 51 71 79 60 77 73 74 69 78 76 70 95 60 70 80 75 70 95 70 50 NA 59 60 60 71 36 64 61 80 90 60 NA 100 NA 30 100 NA 72 81 69 82 83 77 57 82 77 80 70 40 70 70 70 80 85 70 91 90 90 91 91 91 91 91 91 18 40 23 40 45 80 8 80 44 70 60 60 60 70 60 60 80 60 76 100 78 40 95 52 63 100 53 65 80 60 65 80 65 60 81 63 35 81 46 NA 78 63 18 91 71 62 100 69 70 100 95 39 100 100 76 87 58 49 100 73 41 93 73 50 100 69 100 100 100 50 100 68 68 88 71 77 82 80 65 85 81 80 NA 85 60 NA 60 80 60 60 90 100 85 80 90 65 68 100 70 79 93 83 75 87 89 58 98 89 30 60 50 40 75 70 30 85 60 60 85 70 60 NA 70 60 100 60 100 100 100 100 100 100 100 100 100
Names of X columns:
A B C D E F G H I
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