Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1632 0 1385 1507 1508 1687 1511 0 1632 1385 1507 1508 1559 0 1511 1632 1385 1507 1630 0 1559 1511 1632 1385 1579 0 1630 1559 1511 1632 1653 0 1579 1630 1559 1511 2152 0 1653 1579 1630 1559 2148 0 2152 1653 1579 1630 1752 0 2148 2152 1653 1579 1765 0 1752 2148 2152 1653 1717 0 1765 1752 2148 2152 1558 0 1717 1765 1752 2148 1575 0 1558 1717 1765 1752 1520 0 1575 1558 1717 1765 1805 0 1520 1575 1558 1717 1800 0 1805 1520 1575 1558 1719 0 1800 1805 1520 1575 2008 0 1719 1800 1805 1520 2242 0 2008 1719 1800 1805 2478 0 2242 2008 1719 1800 2030 0 2478 2242 2008 1719 1655 0 2030 2478 2242 2008 1693 0 1655 2030 2478 2242 1623 0 1693 1655 2030 2478 1805 0 1623 1693 1655 2030 1746 0 1805 1623 1693 1655 1795 0 1746 1805 1623 1693 1926 0 1795 1746 1805 1623 1619 0 1926 1795 1746 1805 1992 0 1619 1926 1795 1746 2233 0 1992 1619 1926 1795 2192 0 2233 1992 1619 1926 2080 0 2192 2233 1992 1619 1768 0 2080 2192 2233 1992 1835 0 1768 2080 2192 2233 1569 0 1835 1768 2080 2192 1976 0 1569 1835 1768 2080 1853 0 1976 1569 1835 1768 1965 0 1853 1976 1569 1835 1689 0 1965 1853 1976 1569 1778 0 1689 1965 1853 1976 1976 0 1778 1689 1965 1853 2397 0 1976 1778 1689 1965 2654 0 2397 1976 1778 1689 2097 0 2654 2397 1976 1778 1963 0 2097 2654 2397 1976 1677 0 1963 2097 2654 2397 1941 0 1677 1963 2097 2654 2003 0 1941 1677 1963 2097 1813 0 2003 1941 1677 1963 2012 0 1813 2003 1941 1677 1912 0 2012 1813 2003 1941 2084 0 1912 2012 1813 2003 2080 0 2084 1912 2012 1813 2118 0 2080 2084 1912 2012 2150 0 2118 2080 2084 1912 1608 0 2150 2118 2080 2084 1503 0 1608 2150 2118 2080 1548 0 1503 1608 2150 2118 1382 0 1548 1503 1608 2150 1731 0 1382 1548 1503 1608 1798 0 1731 1382 1548 1503 1779 0 1798 1731 1382 1548 1887 0 1779 1798 1731 1382 2004 0 1887 1779 1798 1731 2077 0 2004 1887 1779 1798 2092 0 2077 2004 1887 1779 2051 0 2092 2077 2004 1887 1577 0 2051 2092 2077 2004 1356 0 1577 2051 2092 2077 1652 0 1356 1577 2051 2092 1382 0 1652 1356 1577 2051 1519 0 1382 1652 1356 1577 1421 0 1519 1382 1652 1356 1442 0 1421 1519 1382 1652 1543 0 1442 1421 1519 1382 1656 0 1543 1442 1421 1519 1561 0 1656 1543 1442 1421 1905 0 1561 1656 1543 1442 2199 0 1905 1561 1656 1543 1473 0 2199 1905 1561 1656 1655 0 1473 2199 1905 1561 1407 0 1655 1473 2199 1905 1395 0 1407 1655 1473 2199 1530 0 1395 1407 1655 1473 1309 0 1530 1395 1407 1655 1526 0 1309 1530 1395 1407 1327 0 1526 1309 1530 1395 1627 0 1327 1526 1309 1530 1748 0 1627 1327 1526 1309 1958 0 1748 1627 1327 1526 2274 0 1958 1748 1627 1327 1648 0 2274 1958 1748 1627 1401 0 1648 2274 1958 1748 1411 0 1401 1648 2274 1958 1403 0 1411 1401 1648 2274 1394 0 1403 1411 1401 1648 1520 0 1394 1403 1411 1401 1528 0 1520 1394 1403 1411 1643 0 1528 1520 1394 1403 1515 0 1643 1528 1520 1394 1685 0 1515 1643 1528 1520 2000 0 1685 1515 1643 1528 2215 0 2000 1685 1515 1643 1956 0 2215 2000 1685 1515 1462 0 1956 2215 2000 1685 1563 0 1462 1956 2215 2000 1459 0 1563 1462 1956 2215 1446 0 1459 1563 1462 1956 1622 0 1446 1459 1563 1462 1657 0 1622 1446 1459 1563 1638 0 1657 1622 1446 1459 1643 0 1638 1657 1622 1446 1683 0 1643 1638 1657 1622 2050 0 1683 1643 1638 1657 2262 0 2050 1683 1643 1638 1813 0 2262 2050 1683 1643 1445 0 1813 2262 2050 1683 1762 0 1445 1813 2262 2050 1461 0 1762 1445 1813 2262 1556 0 1461 1762 1445 1813 1431 0 1556 1461 1762 1445 1427 0 1431 1556 1461 1762 1554 0 1427 1431 1556 1461 1645 0 1554 1427 1431 1556 1653 0 1645 1554 1427 1431 2016 0 1653 1645 1554 1427 2207 0 2016 1653 1645 1554 1665 0 2207 2016 1653 1645 1361 0 1665 2207 2016 1653 1506 0 1361 1665 2207 2016 1360 0 1506 1361 1665 2207 1453 0 1360 1506 1361 1665 1522 0 1453 1360 1506 1361 1460 0 1522 1453 1360 1506 1552 0 1460 1522 1453 1360 1548 0 1552 1460 1522 1453 1827 0 1548 1552 1460 1522 1737 0 1827 1548 1552 1460 1941 0 1737 1827 1548 1552 1474 0 1941 1737 1827 1548 1458 0 1474 1941 1737 1827 1542 0 1458 1474 1941 1737 1404 0 1542 1458 1474 1941 1522 0 1404 1542 1458 1474 1385 0 1522 1404 1542 1458 1641 0 1385 1522 1404 1542 1510 0 1641 1385 1522 1404 1681 0 1510 1641 1385 1522 1938 0 1681 1510 1641 1385 1868 0 1938 1681 1510 1641 1726 0 1868 1938 1681 1510 1456 0 1726 1868 1938 1681 1445 0 1456 1726 1868 1938 1456 0 1445 1456 1726 1868 1365 0 1456 1445 1456 1726 1487 0 1365 1456 1445 1456 1558 0 1487 1365 1456 1445 1488 0 1558 1487 1365 1456 1684 0 1488 1558 1487 1365 1594 0 1684 1488 1558 1487 1850 0 1594 1684 1488 1558 1998 0 1850 1594 1684 1488 2079 0 1998 1850 1594 1684 1494 0 2079 1998 1850 1594 1057 1 1494 2079 1998 1850 1218 1 1057 1494 2079 1998 1168 1 1218 1057 1494 2079 1236 1 1168 1218 1057 1494 1076 1 1236 1168 1218 1057 1174 1 1076 1236 1168 1218 1139 1 1174 1076 1236 1168 1427 1 1139 1174 1076 1236 1487 1 1427 1139 1174 1076 1483 1 1487 1427 1139 1174 1513 1 1483 1487 1427 1139 1357 1 1513 1483 1487 1427 1165 1 1357 1513 1483 1487 1282 1 1165 1357 1513 1483 1110 1 1282 1165 1357 1513 1297 1 1110 1282 1165 1357 1185 1 1297 1110 1282 1165 1222 1 1185 1297 1110 1282 1284 1 1222 1185 1297 1110 1444 1 1284 1222 1185 1297 1575 1 1444 1284 1222 1185 1737 1 1575 1444 1284 1222 1763 1 1737 1575 1444 1284
Names of X columns:
Y X Y1 Y2 Y3 Y4
Sample Range:
(leave blank to include all observations)
From:
To:
Column Number of Endogenous Series
(?)
Fixed Seasonal Effects
Include Monthly Dummies
Do not include Seasonal Dummies
Include Seasonal Dummies
Type of Equation
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
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation