Wessa.net

Send output to:

Data X:
87.28 255 87.28 280.2 87.09 299.9 86.92 339.2 87.59 374.2 90.72 393.5 90.69 389.2 90.3 381.7 89.55 375.2 88.94 369 88.41 357.4 87.82 352.1 87.07 346.5 86.82 342.9 86.4 340.3 86.02 328.3 85.66 322.9 85.32 314.3 85 308.9 84.67 294 83.94 285.6 82.83 281.2 81.95 280.3 81.19 278.8 80.48 274.5 78.86 270.4 69.47 263.4 68.77 259.9 70.06 258 73.95 262.7 75.8 284.7 77.79 311.3 81.57 322.1 83.07 327 84.34 331.3 85.1 333.3 85.25 321.4 84.26 327 83.63 320 86.44 314.7 85.3 316.7 84.1 314.4 83.36 321.3 82.48 318.2 81.58 307.2 80.47 301.3 79.34 287.5 82.13 277.7 81.69 274.4 80.7 258.8 79.88 253.3 79.16 251 78.38 248.4 77.42 249.5 76.47 246.1 75.46 244.5 74.48 243.6 78.27 244 80.7 240.8 79.91 249.8 78.75 248 77.78 259.4 81.14 260.5 81.08 260.8 80.03 261.3 78.91 259.5 78.01 256.6 76.9 257.9 75.97 256.5 81.93 254.2 80.27 253.3 78.67 253.8 77.42 255.5 76.16 257.1 74.7 257.3 76.39 253.2 76.04 252.8 74.65 252 73.29 250.7 71.79 252.2 74.39 250 74.91 251 74.54 253.4 73.08 251.2 72.75 255.6 71.32 261.1 70.38 258.9 70.35 259.9 70.01 261.2 69.36 264.7 67.77 267.1 69.26 266.4 69.8 267.7 68.38 268.6 67.62 267.5 68.39 268.5 66.95 268.5 65.21 270.5 66.64 270.9 63.45 270.1 60.66 269.3 62.34 269.8 60.32 270.1 58.64 264.9 60.46 263.7 58.59 264.8 61.87 263.7 61.85 255.9 67.44 276.2 77.06 360.1 91.74 380.5 93.15 373.7 94.15 369.8 93.11 366.6 91.51 359.3 89.96 345.8 88.16 326.2 86.98 324.5 88.03 328.1 86.24 327.5 84.65 324.4 83.23 316.5 81.7 310.9 80.25 301.5 78.8 291.7 77.51 290.4 76.2 287.4 75.04 277.7 74 281.6 75.49 288 77.14 276 76.15 272.9 76.27 283 78.19 283.3 76.49 276.8 77.31 284.5 76.65 282.7 74.99 281.2 73.51 287.4 72.07 283.1 70.59 284 71.96 285.5 76.29 289.2 74.86 292.5 74.93 296.4 71.9 305.2 71.01 303.9 77.47 311.5 75.78 316.3 76.6 316.7 76.07 322.5 74.57 317.1 73.02 309.8 72.65 303.8 73.16 290.3 71.53 293.7 69.78 291.7 67.98 296.5 69.96 289.1 72.16 288.5 70.47 293.8 68.86 297.7 67.37 305.4 65.87 302.7 72.16 302.5 71.34 303 69.93 294.5 68.44 294.1 67.16 294.5 66.01 297.1 67.25 289.4 70.91 292.4 69.75 287.9 68.59 286.6 67.48 280.5 66.31 272.4 64.81 269.2 66.58 270.6 65.97 267.3 64.7 262.5 64.7 266.8 60.94 268.8 59.08 263.1 58.42 261.2 57.77 266 57.11 262.5 53.31 265.2 49.96 261.3 49.4 253.7 48.84 249.2 48.3 239.1 47.74 236.4 47.24 235.2 46.76 245.2 46.29 246.2 48.9 247.7 49.23 251.4 48.53 253.3 48.03 254.8 54.34 250 53.79 249.3 53.24 241.5 52.96 243.3 52.17 248 51.7 253 58.55 252.9 78.2 251.5 77.03 251.6 76.19 253.5 77.15 259.8 75.87 334.1 95.47 448 109.67 445.8 112.28 445 112.01 448.2 107.93 438.2 105.96 439.8 105.06 423.4 102.98 410.8 102.2 408.4 105.23 406.7 101.85 405.9 99.89 402.7 96.23 405.1 94.76 399.6 91.51 386.5 91.63 381.4 91.54 375.2 85.23 357.7 87.83 359 87.38 355 84.44 352.7 85.19 344.4 84.03 343.8 86.73 338 102.52 339 104.45 333.3 106.98 334.4 107.02 328.3 99.26 330.7 94.45 330 113.44 331.6 157.33 351.2 147.38 389.4 171.89 410.9 171.95 442.8 132.71 462.8 126.02 466.9 121.18 461.7 115.45 439.2 110.48 430.3 117.85 416.1 117.63 402.5 124.65 397.3 109.59 403.3 111.27 395.9 99.78 387.8 98.21 378.6 99.2 377.1 97.97 370.4 89.55 362 87.91 350.3 93.34 348.2 94.42 344.6 93.2 343.5 90.29 342.8 91.46 347.6 89.98 346.6 88.35 349.5 88.41 342.1 82.44 342 79.89 342.8 75.69 339.3 75.66 348.2 84.5 333.7 96.73 334.7 87.48 354 82.39 367.7 83.48 363.3 79.31 358.4 78.16 353.1 72.77 343.1 72.45 344.6 68.46 344.4 67.62 333.9 68.76 331.7 70.07 324.3 68.55 321.2 65.3 322.4 58.96 321.7 59.17 320.5 62.37 312.8 66.28 309.7 55.62 315.6 55.23 309.7 55.85 304.6 56.75 302.5 50.89 301.5 53.88 298.8 52.95 291.3 55.08 293.6 53.61 294.6 58.78 285.9 61.85 297.6 55.91 301.1 53.32 293.8 46.41 297.7 44.57 292.9 50 292.1 50 287.2 53.36 288.2 46.23 283.8 50.45 299.9 49.07 292.4 45.85 293.3 48.45 300.8 49.96 293.7 46.53 293.1 50.51 294.4 47.58 292.1 48.05 291.9 46.84 282.5 47.67 277.9 49.16 287.5 55.54 289.2 55.82 285.6 58.22 293.2 56.19 290.8 57.77 283.1 63.19 275 54.76 287.8 55.74 287.8 62.54 287.4 61.39 284 69.6 277.8 79.23 277.6 80 304.9 93.68 294 107.63 300.9 100.18 324 97.3 332.9 90.45 341.6 80.64 333.4 80.58 348.2 75.82 344.7 85.59 344.7 89.35 329.3 89.42 323.5 104.73 323.2 95.32 317.4 89.27 330.1 90.44 329.2 86.97 334.9 79.98 315.8 81.22 315.4 87.35 319.6 83.64 317.3 82.22 313.8 94.4 315.8 102.18 311.3
Names of X columns:
Columbia USA

Sample Range: (leave blank to include all observations)
From:
To:

Column Number of Endogenous Series (?)


Fixed Seasonal Effects


Type of Equation


Degree of Predetermination (lagged endogenous variables)


Degree of Seasonal Predetermination


Seasonality


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') }

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