Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1478 1999 1 0 0 0 0 0 0 0 0 0 0 1323 1999 0 1 0 0 0 0 0 0 0 0 0 1381 1999 0 0 1 0 0 0 0 0 0 0 0 1411 1999 0 0 0 1 0 0 0 0 0 0 0 1419 1999 0 0 0 0 1 0 0 0 0 0 0 1375 1999 0 0 0 0 0 1 0 0 0 0 0 1437 1999 0 0 0 0 0 0 1 0 0 0 0 1421 1999 0 0 0 0 0 0 0 1 0 0 0 1294 1999 0 0 0 0 0 0 0 0 1 0 0 1406 1999 0 0 0 0 0 0 0 0 0 1 0 1362 1999 0 0 0 0 0 0 0 0 0 0 1 1292 1999 0 0 0 0 0 0 0 0 0 0 0 1447 2000 1 0 0 0 0 0 0 0 0 0 0 1318 2000 0 1 0 0 0 0 0 0 0 0 0 1468 2000 0 0 1 0 0 0 0 0 0 0 0 1372 2000 0 0 0 1 0 0 0 0 0 0 0 1449 2000 0 0 0 0 1 0 0 0 0 0 0 1415 2000 0 0 0 0 0 1 0 0 0 0 0 1434 2000 0 0 0 0 0 0 1 0 0 0 0 1410 2000 0 0 0 0 0 0 0 1 0 0 0 1318 2000 0 0 0 0 0 0 0 0 1 0 0 1383 2000 0 0 0 0 0 0 0 0 0 1 0 1294 2000 0 0 0 0 0 0 0 0 0 0 1 1278 2000 0 0 0 0 0 0 0 0 0 0 0 1443 2001 1 0 0 0 0 0 0 0 0 0 0 1328 2001 0 1 0 0 0 0 0 0 0 0 0 1441 2001 0 0 1 0 0 0 0 0 0 0 0 1438 2001 0 0 0 1 0 0 0 0 0 0 0 1536 2001 0 0 0 0 1 0 0 0 0 0 0 1340 2001 0 0 0 0 0 1 0 0 0 0 0 1424 2001 0 0 0 0 0 0 1 0 0 0 0 1441 2001 0 0 0 0 0 0 0 1 0 0 0 1304 2001 0 0 0 0 0 0 0 0 1 0 0 1432 2001 0 0 0 0 0 0 0 0 0 1 0 1387 2001 0 0 0 0 0 0 0 0 0 0 1 1355 2001 0 0 0 0 0 0 0 0 0 0 0 1477 2002 1 0 0 0 0 0 0 0 0 0 0 1332 2002 0 1 0 0 0 0 0 0 0 0 0 1423 2002 0 0 1 0 0 0 0 0 0 0 0 1510 2002 0 0 0 1 0 0 0 0 0 0 0 1451 2002 0 0 0 0 1 0 0 0 0 0 0 1408 2002 0 0 0 0 0 1 0 0 0 0 0 1479 2002 0 0 0 0 0 0 1 0 0 0 0 1480 2002 0 0 0 0 0 0 0 1 0 0 0 1440 2002 0 0 0 0 0 0 0 0 1 0 0 1427 2002 0 0 0 0 0 0 0 0 0 1 0 1349 2002 0 0 0 0 0 0 0 0 0 0 1 1332 2002 0 0 0 0 0 0 0 0 0 0 0 1509 2003 1 0 0 0 0 0 0 0 0 0 0 1260 2003 0 1 0 0 0 0 0 0 0 0 0 1498 2003 0 0 1 0 0 0 0 0 0 0 0 1467 2003 0 0 0 1 0 0 0 0 0 0 0 1469 2003 0 0 0 0 1 0 0 0 0 0 0 1517 2003 0 0 0 0 0 1 0 0 0 0 0 1455 2003 0 0 0 0 0 0 1 0 0 0 0 1429 2003 0 0 0 0 0 0 0 1 0 0 0 1335 2003 0 0 0 0 0 0 0 0 1 0 0 1377 2003 0 0 0 0 0 0 0 0 0 1 0 1296 2003 0 0 0 0 0 0 0 0 0 0 1 1295 2003 0 0 0 0 0 0 0 0 0 0 0 1420 2004 1 0 0 0 0 0 0 0 0 0 0 1362 2004 0 1 0 0 0 0 0 0 0 0 0 1467 2004 0 0 1 0 0 0 0 0 0 0 0 1378 2004 0 0 0 1 0 0 0 0 0 0 0 1427 2004 0 0 0 0 1 0 0 0 0 0 0 1386 2004 0 0 0 0 0 1 0 0 0 0 0 1465 2004 0 0 0 0 0 0 1 0 0 0 0 1423 2004 0 0 0 0 0 0 0 1 0 0 0 1341 2004 0 0 0 0 0 0 0 0 1 0 0 1421 2004 0 0 0 0 0 0 0 0 0 1 0 1395 2004 0 0 0 0 0 0 0 0 0 0 1 1265 2004 0 0 0 0 0 0 0 0 0 0 0 1390 2005 1 0 0 0 0 0 0 0 0 0 0 1319 2005 0 1 0 0 0 0 0 0 0 0 0 1457 2005 0 0 1 0 0 0 0 0 0 0 0 1466 2005 0 0 0 1 0 0 0 0 0 0 0 1492 2005 0 0 0 0 1 0 0 0 0 0 0 1398 2005 0 0 0 0 0 1 0 0 0 0 0 1503 2005 0 0 0 0 0 0 1 0 0 0 0 1419 2005 0 0 0 0 0 0 0 1 0 0 0 1435 2005 0 0 0 0 0 0 0 0 1 0 0 1438 2005 0 0 0 0 0 0 0 0 0 1 0 1284 2005 0 0 0 0 0 0 0 0 0 0 1 1401 2005 0 0 0 0 0 0 0 0 0 0 0 1364 2006 1 0 0 0 0 0 0 0 0 0 0 1231 2006 0 1 0 0 0 0 0 0 0 0 0 1424 2006 0 0 1 0 0 0 0 0 0 0 0 1390 2006 0 0 0 1 0 0 0 0 0 0 0 1483 2006 0 0 0 0 1 0 0 0 0 0 0 1479 2006 0 0 0 0 0 1 0 0 0 0 0 1553 2006 0 0 0 0 0 0 1 0 0 0 0 1409 2006 0 0 0 0 0 0 0 1 0 0 0 1416 2006 0 0 0 0 0 0 0 0 1 0 0 1466 2006 0 0 0 0 0 0 0 0 0 1 0 1341 2006 0 0 0 0 0 0 0 0 0 0 1 1327 2006 0 0 0 0 0 0 0 0 0 0 0 1449 2007 1 0 0 0 0 0 0 0 0 0 0 1275 2007 0 1 0 0 0 0 0 0 0 0 0 1440 2007 0 0 1 0 0 0 0 0 0 0 0 1401 2007 0 0 0 1 0 0 0 0 0 0 0 1562 2007 0 0 0 0 1 0 0 0 0 0 0 1467 2007 0 0 0 0 0 1 0 0 0 0 0 1539 2007 0 0 0 0 0 0 1 0 0 0 0 1444 2007 0 0 0 0 0 0 0 1 0 0 0 1494 2007 0 0 0 0 0 0 0 0 1 0 0 1493 2007 0 0 0 0 0 0 0 0 0 1 0 1439 2007 0 0 0 0 0 0 0 0 0 0 1 1349 2007 0 0 0 0 0 0 0 0 0 0 0 1595 2008 1 0 0 0 0 0 0 0 0 0 0 1447 2008 0 1 0 0 0 0 0 0 0 0 0 1604 2008 0 0 1 0 0 0 0 0 0 0 0 1558 2008 0 0 0 1 0 0 0 0 0 0 0 1538 2008 0 0 0 0 1 0 0 0 0 0 0 1507 2008 0 0 0 0 0 1 0 0 0 0 0 1564 2008 0 0 0 0 0 0 1 0 0 0 0 1513 2008 0 0 0 0 0 0 0 1 0 0 0 1518 2008 0 0 0 0 0 0 0 0 1 0 0 1516 2008 0 0 0 0 0 0 0 0 0 1 0 1431 2008 0 0 0 0 0 0 0 0 0 0 1 1432 2008 0 0 0 0 0 0 0 0 0 0 0 1576 2009 1 0 0 0 0 0 0 0 0 0 0 1424 2009 0 1 0 0 0 0 0 0 0 0 0 1528 2009 0 0 1 0 0 0 0 0 0 0 0 1546 2009 0 0 0 1 0 0 0 0 0 0 0 1641 2009 0 0 0 0 1 0 0 0 0 0 0 1618 2009 0 0 0 0 0 1 0 0 0 0 0 1673 2009 0 0 0 0 0 0 1 0 0 0 0 1669 2009 0 0 0 0 0 0 0 1 0 0 0 1605 2009 0 0 0 0 0 0 0 0 1 0 0 1615 2009 0 0 0 0 0 0 0 0 0 1 0 1416 2009 0 0 0 0 0 0 0 0 0 0 1 1424 2009 0 0 0 0 0 0 0 0 0 0 0 1568 2010 1 0 0 0 0 0 0 0 0 0 0 1426 2010 0 1 0 0 0 0 0 0 0 0 0 1661 2010 0 0 1 0 0 0 0 0 0 0 0 1618 2010 0 0 0 1 0 0 0 0 0 0 0 1653 2010 0 0 0 0 1 0 0 0 0 0 0 1656 2010 0 0 0 0 0 1 0 0 0 0 0 1774 2010 0 0 0 0 0 0 1 0 0 0 0 1723 2010 0 0 0 0 0 0 0 1 0 0 0 1555 2010 0 0 0 0 0 0 0 0 1 0 0 1655 2010 0 0 0 0 0 0 0 0 0 1 0 1526 2010 0 0 0 0 0 0 0 0 0 0 1 1577 2010 0 0 0 0 0 0 0 0 0 0 0 1588 2011 1 0 0 0 0 0 0 0 0 0 0 1394 2011 0 1 0 0 0 0 0 0 0 0 0 1758 2011 0 0 1 0 0 0 0 0 0 0 0 1784 2011 0 0 0 1 0 0 0 0 0 0 0 1723 2011 0 0 0 0 1 0 0 0 0 0 0 1717 2011 0 0 0 0 0 1 0 0 0 0 0 1818 2011 0 0 0 0 0 0 1 0 0 0 0 1770 2011 0 0 0 0 0 0 0 1 0 0 0 1618 2011 0 0 0 0 0 0 0 0 1 0 0 1690 2011 0 0 0 0 0 0 0 0 0 1 0 1554 2011 0 0 0 0 0 0 0 0 0 0 1 1576 2011 0 0 0 0 0 0 0 0 0 0 0 1707 2012 1 0 0 0 0 0 0 0 0 0 0 1549 2012 0 1 0 0 0 0 0 0 0 0 0 1707 2012 0 0 1 0 0 0 0 0 0 0 0 1745 2012 0 0 0 1 0 0 0 0 0 0 0 1932 2012 0 0 0 0 1 0 0 0 0 0 0 1724 2012 0 0 0 0 0 1 0 0 0 0 0 1789 2012 0 0 0 0 0 0 1 0 0 0 0 1796 2012 0 0 0 0 0 0 0 1 0 0 0 1717 2012 0 0 0 0 0 0 0 0 1 0 0 1696 2012 0 0 0 0 0 0 0 0 0 1 0 1680 2012 0 0 0 0 0 0 0 0 0 0 1 1624 2012 0 0 0 0 0 0 0 0 0 0 0 1797 2013 1 0 0 0 0 0 0 0 0 0 0 1592 2013 0 1 0 0 0 0 0 0 0 0 0 1870 2013 0 0 1 0 0 0 0 0 0 0 0 1819 2013 0 0 0 1 0 0 0 0 0 0 0 1791 2013 0 0 0 0 1 0 0 0 0 0 0 1797 2013 0 0 0 0 0 1 0 0 0 0 0 1893 2013 0 0 0 0 0 0 1 0 0 0 0 1786 2013 0 0 0 0 0 0 0 1 0 0 0 1728 2013 0 0 0 0 0 0 0 0 1 0 0 1741 2013 0 0 0 0 0 0 0 0 0 1 0 1698 2013 0 0 0 0 0 0 0 0 0 0 1 1663 2013 0 0 0 0 0 0 0 0 0 0 0 1716 2014 1 0 0 0 0 0 0 0 0 0 0 1592 2014 0 1 0 0 0 0 0 0 0 0 0 1733 2014 0 0 1 0 0 0 0 0 0 0 0 1874 2014 0 0 0 1 0 0 0 0 0 0 0 1784 2014 0 0 0 0 1 0 0 0 0 0 0 1848 2014 0 0 0 0 0 1 0 0 0 0 0 1843 2014 0 0 0 0 0 0 1 0 0 0 0 1863 2014 0 0 0 0 0 0 0 1 0 0 0 1901 2014 0 0 0 0 0 0 0 0 1 0 0 1822 2014 0 0 0 0 0 0 0 0 0 1 0 1712 2014 0 0 0 0 0 0 0 0 0 0 1 1698 2014 0 0 0 0 0 0 0 0 0 0 0 1819 2015 1 0 0 0 0 0 0 0 0 0 0 1632 2015 0 1 0 0 0 0 0 0 0 0 0 1941 2015 0 0 1 0 0 0 0 0 0 0 0 1932 2015 0 0 0 1 0 0 0 0 0 0 0 1942 2015 0 0 0 0 1 0 0 0 0 0 0 1838 2015 0 0 0 0 0 1 0 0 0 0 0 1968 2015 0 0 0 0 0 0 1 0 0 0 0 1905 2015 0 0 0 0 0 0 0 1 0 0 0 1778 2015 0 0 0 0 0 0 0 0 1 0 0 1806 2015 0 0 0 0 0 0 0 0 0 1 0 1687 2015 0 0 0 0 0 0 0 0 0 0 1 1770 2015 0 0 0 0 0 0 0 0 0 0 0
Names of X columns:
firearm year jan feb mar apr may jun jul aug sep oct nov
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
12
1
2
3
4
5
6
7
8
9
10
11
12
Chart options
R Code
par6 <- '12' par5 <- '' par4 <- '' par3 <- 'No Linear Trend' par2 <- 'Do not include Seasonal Dummies' par1 <- '1' library(lattice) library(lmtest) library(car) library(MASS) n25 <- 25 #minimum number of obs. for Goldfeld-Quandt test mywarning <- '' par6 <- as.numeric(par6) if(is.na(par6)) { par6 <- 12 mywarning = 'Warning: you did not specify the seasonality. The seasonal period was set to s = 12.' } par1 <- as.numeric(par1) if(is.na(par1)) { par1 <- 1 mywarning = 'Warning: you did not specify the column number of the endogenous series! The first column was selected by default.' } if (par4=='') par4 <- 0 par4 <- as.numeric(par4) if (!is.numeric(par4)) par4 <- 0 if (par5=='') par5 <- 0 par5 <- as.numeric(par5) if (!is.numeric(par5)) par5 <- 0 x <- na.omit(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'){ (n <- n -1) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 } if (par3 == 'Seasonal Differences (s)'){ (n <- n - par6) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-Bs)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+par6,j] - x[i,j] } } x <- x2 } if (par3 == 'First and Seasonal Differences (s)'){ (n <- n -1) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-B)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+1,j] - x[i,j] } } x <- x2 (n <- n - par6) x2 <- array(0, dim=c(n,k), dimnames=list(1:n, paste('(1-Bs)',colnames(x),sep=''))) for (i in 1:n) { for (j in 1:k) { x2[i,j] <- x[i+par6,j] - x[i,j] } } x <- x2 } if(par4 > 0) { x2 <- array(0, dim=c(n-par4,par4), dimnames=list(1:(n-par4), paste(colnames(x)[par1],'(t-',1:par4,')',sep=''))) for (i in 1:(n-par4)) { for (j in 1:par4) { x2[i,j] <- x[i+par4-j,par1] } } x <- cbind(x[(par4+1):n,], x2) n <- n - par4 } if(par5 > 0) { x2 <- array(0, dim=c(n-par5*par6,par5), dimnames=list(1:(n-par5*par6), paste(colnames(x)[par1],'(t-',1:par5,'s)',sep=''))) for (i in 1:(n-par5*par6)) { for (j in 1:par5) { x2[i,j] <- x[i+par5*par6-j*par6,par1] } } x <- cbind(x[(par5*par6+1):n,], x2) n <- n - par5*par6 } if (par2 == 'Include Seasonal Dummies'){ x2 <- array(0, dim=c(n,par6-1), dimnames=list(1:n, paste('M', seq(1:(par6-1)), sep =''))) for (i in 1:(par6-1)){ x2[seq(i,n,par6),i] <- 1 } x <- cbind(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[n,])) if (par3 == 'Linear Trend'){ x <- cbind(x, c(1:n)) colnames(x)[k+1] <- 't' } print(x) (k <- length(x[n,])) head(x) 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') sresid <- studres(mylm) hist(sresid, freq=FALSE, main='Distribution of Studentized Residuals') xfit<-seq(min(sresid),max(sresid),length=40) yfit<-dnorm(xfit) lines(xfit, yfit) 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') qqPlot(mylm, main='QQ Plot') 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) print(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.row.start(a) a<-table.element(a, mywarning) 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,'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,formatC(signif(mysum$coefficients[i,1],5),format='g',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,2],5),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,3],4),format='e',flag='+')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4],4),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$coefficients[i,4]/2,4),format='g',flag=' ')) 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,formatC(signif(sqrt(mysum$r.squared),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Adjusted R-squared',1,TRUE) a<-table.element(a,formatC(signif(mysum$adj.r.squared,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'F-TEST (value)',1,TRUE) a<-table.element(a,formatC(signif(mysum$fstatistic[1],6),format='g',flag=' ')) 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,formatC(signif(1-pf(mysum$fstatistic[1],mysum$fstatistic[2],mysum$fstatistic[3]),6),format='g',flag=' ')) 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,formatC(signif(mysum$sigma,6),format='g',flag=' ')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a, 'Sum Squared Residuals',1,TRUE) a<-table.element(a,formatC(signif(sum(myerror*myerror),6),format='g',flag=' ')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable3.tab') myr <- as.numeric(mysum$resid) myr a <-table.start() a <- table.row.start(a) a <- table.element(a,'Menu of Residual Diagnostics',2,TRUE) a <- table.row.end(a) a <- table.row.start(a) a <- table.element(a,'Description',1,TRUE) a <- table.element(a,'Link',1,TRUE) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Histogram',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_histogram.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_centraltendency.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'QQ Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_fitdistrnorm.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Kernel Density Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_density.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Skewness/Kurtosis Test',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_skewness_kurtosis.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Skewness-Kurtosis Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_skewness_kurtosis_plot.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Harrell-Davis Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_harrell_davis.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Bootstrap Plot -- Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_bootstrapplot1.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Blocked Bootstrap Plot -- Central Tendency',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_bootstrapplot.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'(Partial) Autocorrelation Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_autocorrelation.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Spectral Analysis',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_spectrum.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Tukey lambda PPCC Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_tukeylambda.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <-table.element(a,'Box-Cox Normality Plot',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_boxcoxnorm.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a <- table.row.start(a) a <- table.element(a,'Summary Statistics',1,header=TRUE) a <- table.element(a,hyperlink( paste('https://supernova.wessa.net/rwasp_summary1.wasp?convertgetintopost=1&data=',paste(as.character(mysum$resid),sep='',collapse=' '),sep='') ,'Compute','Click here to examine the Residuals.'),1) a <- table.row.end(a) a<-table.end(a) table.save(a,file='mytable7.tab') if(n < 200) { 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,formatC(signif(x[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(x[i]-mysum$resid[i],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(mysum$resid[i],6),format='g',flag=' ')) 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,formatC(signif(gqarr[mypoint-kp3+1,1],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,2],6),format='g',flag=' ')) a<-table.element(a,formatC(signif(gqarr[mypoint-kp3+1,3],6),format='g',flag=' ')) 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,formatC(signif(numsignificant1/numgqtests,6),format='g',flag=' ')) 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') } } a<-table.start() a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of fitted values',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_fitted <- resettest(mylm,power=2:3,type='fitted') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_fitted'),'</pre>',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of regressors',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_regressors <- resettest(mylm,power=2:3,type='regressor') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_regressors'),'</pre>',sep='')) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Ramsey RESET F-Test for powers (2 and 3) of principal components',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) reset_test_principal_components <- resettest(mylm,power=2:3,type='princomp') a<-table.element(a,paste('<pre>',RC.texteval('reset_test_principal_components'),'</pre>',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable8.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Variance Inflation Factors (Multicollinearity)',1,TRUE) a<-table.row.end(a) a<-table.row.start(a) vif <- vif(mylm) a<-table.element(a,paste('<pre>',RC.texteval('vif'),'</pre>',sep='')) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable9.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