[Returnanalytics-commits] r3005 - in pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code: . Data Tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Sep 5 23:31:44 CEST 2013
Author: shubhanm
Date: 2013-09-05 23:31:44 +0200 (Thu, 05 Sep 2013)
New Revision: 3005
Added:
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Data/inst/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Data/man/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Cross Sectional Data.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/HAC Data.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Tests.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Time Series Data.R
Removed:
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/R Tests/
Log:
Change of Folder
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Cross Sectional Data.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Cross Sectional Data.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Cross Sectional Data.R 2013-09-05 21:31:44 UTC (rev 3005)
@@ -0,0 +1,79 @@
+library("sandwich")
+library("lmtest")
+library("strucchange")
+data("PublicSchools")
+ps <- na.omit(PublicSchools)
+ps$Income <- ps$Income * 0.0001
+fm.ps <- lm(Expenditure ~ Income + I(Income^3), data = ps)
+sqrt(diag(vcov(fm.ps)))
+sqrt(diag(vcovHC(fm.ps, type = "const")))
+sqrt(diag(vcovHC(fm.ps, type = "HC0")))
+sqrt(diag(vcovHC(fm.ps, type = "HC3")))
+sqrt(diag(vcovHC(fm.ps, type = "HC4")))
+coeftest(fm.ps, df = Inf, vcov = vcovHC(fm.ps, type = "HC0"))
+coeftest(fm.ps, df = Inf, vcov = vcovHC(fm.ps, type = "HC4"))
+plot(Expenditure ~ Income, data = ps,
+ xlab = "per capita income",
+ ylab = "per capita spending on public schools")
+inc <- seq(0.5, 1.2, by = 0.001)
+lines(inc, predict(fm.ps, data.frame(Income = inc)), col = 4, lty = 2)
+fm.ps2 <- lm(Expenditure ~ Income, data = ps)
+abline(fm.ps2, col = 4)
+text(ps[2,2], ps[2,1], rownames(ps)[2], pos = 2)
+## Willam H. Greene, Econometric Analysis, 2nd Ed.
+## Chapter 14
+## load data set, p. 385, Table 14.1
+data(PublicSchools)
+
+## omit NA in Wisconsin and scale income
+ps <- na.omit(PublicSchools)
+ps$Income <- ps$Income * 0.0001
+
+## fit quadratic regression, p. 385, Table 14.2
+fmq <- lm(Expenditure ~ Income + I(Income^2), data = ps)
+summary(fmq)
+
+## compare standard and HC0 standard errors
+## p. 391, Table 14.3
+library(sandwich)
+coef(fmq)
+sqrt(diag(vcovHC(fmq, type = "const")))
+sqrt(diag(vcovHC(fmq, type = "HC0")))
+
+if(require(lmtest)) {
+ ## compare t ratio
+ coeftest(fmq, vcov = vcovHC(fmq, type = "HC0"))
+
+ ## White test, p. 393, Example 14.5
+ wt <- lm(residuals(fmq)^2 ~ poly(Income, 4), data = ps)
+ wt.stat <- summary(wt)$r.squared * nrow(ps)
+ c(wt.stat, pchisq(wt.stat, df = 3, lower = FALSE))
+
+ ## Bresch-Pagan test, p. 395, Example 14.7
+ bptest(fmq, studentize = FALSE)
+ bptest(fmq)
+
+ ## Francisco Cribari-Neto, Asymptotic Inference, CSDA 45
+ ## quasi z-tests, p. 229, Table 8
+ ## with Alaska
+ coeftest(fmq, df = Inf)[3,4]
+ coeftest(fmq, df = Inf, vcov = vcovHC(fmq, type = "HC0"))[3,4]
+ coeftest(fmq, df = Inf, vcov = vcovHC(fmq, type = "HC3"))[3,4]
+ coeftest(fmq, df = Inf, vcov = vcovHC(fmq, type = "HC4"))[3,4]
+ ## without Alaska (observation 2)
+ fmq1 <- lm(Expenditure ~ Income + I(Income^2), data = ps[-2,])
+ coeftest(fmq1, df = Inf)[3,4]
+ coeftest(fmq1, df = Inf, vcov = vcovHC(fmq1, type = "HC0"))[3,4]
+ coeftest(fmq1, df = Inf, vcov = vcovHC(fmq1, type = "HC3"))[3,4]
+ coeftest(fmq1, df = Inf, vcov = vcovHC(fmq1, type = "HC4"))[3,4]
+}
+
+## visualization, p. 230, Figure 1
+plot(Expenditure ~ Income, data = ps,
+ xlab = "per capita income",
+ ylab = "per capita spending on public schools")
+inc <- seq(0.5, 1.2, by = 0.001)
+lines(inc, predict(fmq, data.frame(Income = inc)), col = 4)
+fml <- lm(Expenditure ~ Income, data = ps)
+abline(fml)
+text(ps[2,2], ps[2,1], rownames(ps)[2], pos = 2)
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/HAC Data.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/HAC Data.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/HAC Data.R 2013-09-05 21:31:44 UTC (rev 3005)
@@ -0,0 +1,17 @@
+data("RealInt")
+#OLS-based CUSUM test with quadratic spectral kernel HAC estimate:
+ ocus <- gefp(RealInt ~ 1, fit = lm, vcov = kernHAC)
+plot(ocus, aggregate = FALSE)
+sctest(ocus)
+#supF test with quadratic spectral kernel HAC estimate:
+ fs <- Fstats(RealInt ~ 1, vcov = kernHAC)
+plot(fs)
+sctest(fs)
+#Breakpoint estimation and confidence intervals with quadratic spectral kernel HAC estimate:
+ bp <- breakpoints(RealInt ~ 1)
+confint(bp, vcov = kernHAC)
+plot(bp)
+#Visualization:
+ plot(RealInt, ylab = "Real interest rate")
+lines(ts(fitted(bp), start = start(RealInt), freq = 4), col = 4)
+lines(confint(bp, vcov = kernHAC))
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Tests.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Tests.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Tests.R 2013-09-05 21:31:44 UTC (rev 3005)
@@ -0,0 +1,21 @@
+fpe <- read.table("http://data.princeton.edu/wws509/datasets/effort.dat")
+attach(fpe)
+lmfit = lm( change ~ setting + effort )
+sandwich(lmfit)
+Fr <- c(68,42,42,30, 37,52,24,43,
+ 66,50,33,23, 47,55,23,47,
+ 63,53,29,27, 57,49,19,29)
+
+Temp <- gl(2, 2, 24, labels = c("Low", "High"))
+Soft <- gl(3, 8, 24, labels = c("Hard","Medium","Soft"))
+M.user <- gl(2, 4, 24, labels = c("N", "Y"))
+Brand <- gl(2, 1, 24, labels = c("X", "M"))
+
+detg <- data.frame(Fr,Temp, Soft,M.user, Brand)
+detg.m0 <- glm(Fr ~ M.user*Temp*Soft + Brand, family = poisson, data = detg)
+summary(detg.m0)
+
+detg.mod <- glm(terms(Fr ~ M.user*Temp*Soft + Brand*M.user*Temp,
+ keep.order = TRUE),
+ family = poisson, data = detg)
+sandwich(detg.mod)
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Time Series Data.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Time Series Data.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week6-7/Code/Tests/Time Series Data.R 2013-09-05 21:31:44 UTC (rev 3005)
@@ -0,0 +1,78 @@
+## Willam H. Greene, Econometric Analysis, 2nd Ed.
+## Chapter 15
+## load data set, p. 411, Table 15.1
+data(Investment)
+
+## fit linear model, p. 412, Table 15.2
+fm <- lm(RealInv ~ RealGNP + RealInt, data = Investment)
+summary(fm)
+
+## visualize residuals, p. 412, Figure 15.1
+plot(ts(residuals(fm), start = 1964),
+ type = "b", pch = 19, ylim = c(-35, 35), ylab = "Residuals")
+sigma <- sqrt(sum(residuals(fm)^2)/fm$df.residual) ## maybe used df = 26 instead of 16 ??
+abline(h = c(-2, 0, 2) * sigma, lty = 2)
+
+if(require(lmtest)) {
+ ## Newey-West covariances, Example 15.3
+ coeftest(fm, vcov = NeweyWest(fm, lag = 4))
+ ## Note, that the following is equivalent:
+ coeftest(fm, vcov = kernHAC(fm, kernel = "Bartlett", bw = 5, prewhite = FALSE, adjust = FALSE))
+
+ ## Durbin-Watson test, p. 424, Example 15.4
+ dwtest(fm)
+
+ ## Breusch-Godfrey test, p. 427, Example 15.6
+ bgtest(fm, order = 4)
+}
+
+## visualize fitted series
+plot(Investment[, "RealInv"], type = "b", pch = 19, ylab = "Real investment")
+lines(ts(fitted(fm), start = 1964), col = 4)
+
+## 3-d visualization of fitted model
+if(require(scatterplot3d)) {
+ s3d <- scatterplot3d(Investment[,c(5,7,6)],
+ type = "b", angle = 65, scale.y = 1, pch = 16)
+ s3d$plane3d(fm, lty.box = "solid", col = 4)
+}
+## fit investment equation
+data(Investment)
+fm <- lm(RealInv ~ RealGNP + RealInt, data = Investment)
+
+## Newey & West (1994) compute this type of estimator
+NeweyWest(fm)
+
+## The Newey & West (1987) estimator requires specification
+## of the lag and suppression of prewhitening
+NeweyWest(fm, lag = 4, prewhite = FALSE)
+
+## bwNeweyWest() can also be passed to kernHAC(), e.g.
+## for the quadratic spectral kernel
+kernHAC(fm, bw = bwNeweyWest)
+
+curve(kweights(x, kernel = "Quadratic", normalize = TRUE),
+ from = 0, to = 3.2, xlab = "x", ylab = "k(x)")
+curve(kweights(x, kernel = "Bartlett", normalize = TRUE),
+ from = 0, to = 3.2, col = 2, add = TRUE)
+curve(kweights(x, kernel = "Parzen", normalize = TRUE),
+ from = 0, to = 3.2, col = 3, add = TRUE)
+curve(kweights(x, kernel = "Tukey", normalize = TRUE),
+ from = 0, to = 3.2, col = 4, add = TRUE)
+curve(kweights(x, kernel = "Truncated", normalize = TRUE),
+ from = 0, to = 3.2, col = 5, add = TRUE)
+
+## fit investment equation
+data(Investment)
+fm <- lm(RealInv ~ RealGNP + RealInt, data = Investment)
+
+## compute quadratic spectral kernel HAC estimator
+kernHAC(fm)
+kernHAC(fm, verbose = TRUE)
+
+## use Parzen kernel instead, VAR(2) prewhitening, no finite sample
+## adjustment and Newey & West (1994) bandwidth selection
+kernHAC(fm, kernel = "Parzen", prewhite = 2, adjust = FALSE,
+ bw = bwNeweyWest, verbose = TRUE)
+## compare with estimate under assumption of spheric errors
+vcov(fm)
\ No newline at end of file
More information about the Returnanalytics-commits
mailing list