[Gmm-commits] r151 - in pkg/gmm4: . R man vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 6 23:42:07 CET 2019
Author: chaussep
Date: 2019-11-06 23:42:07 +0100 (Wed, 06 Nov 2019)
New Revision: 151
Added:
pkg/gmm4/man/kernapply-methods.Rd
Removed:
pkg/gmm4/man/smoothGel.Rd
Modified:
pkg/gmm4/NAMESPACE
pkg/gmm4/R/allClasses.R
pkg/gmm4/R/gel.R
pkg/gmm4/R/gelModels-methods.R
pkg/gmm4/R/gmmModels-methods.R
pkg/gmm4/R/rGelModel-methods.R
pkg/gmm4/R/validity.R
pkg/gmm4/man/lambdaAlgo.Rd
pkg/gmm4/man/restModel-methods.Rd
pkg/gmm4/man/rhoFct.Rd
pkg/gmm4/vignettes/gelS4.Rnw
pkg/gmm4/vignettes/gelS4.pdf
pkg/gmm4/vignettes/gmmS4.Rnw
pkg/gmm4/vignettes/gmmS4.pdf
Log:
working on the vignette
Modified: pkg/gmm4/NAMESPACE
===================================================================
--- pkg/gmm4/NAMESPACE 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/NAMESPACE 2019-11-06 22:42:07 UTC (rev 151)
@@ -27,7 +27,8 @@
"rlinearGel", "nonlinearGel", "rfunctionGel", "rformulaGel",
"rgelModels","callORNULL")
exportMethods(residuals, print, show, vcovHAC, coef, vcov, bread, summary, update,
- model.matrix, hypothesisTest, "[", merge, subset, confint, gmmToGel)
+ model.matrix, hypothesisTest, "[", merge, subset, confint, gmmToGel,
+ kernapply)
export(gmmModel, evalMoment, Dresiduals, evalDMoment, momentVcov, estfun.gmmFct,
evalWeights, quadra, evalObjective, solveGmm, momentStrength,evalModel,
@@ -34,7 +35,7 @@
tsls, modelFit, meatGmm, specTest, gmm4, restModel, modelResponse, DWH,
modelDims, printRestrict, getRestrict, sysGmmModel, ThreeSLS, gelModel,
rhoET, rhoEL, rhoEEL, rhoHD, Wu_lam, EEL_lam, REEL_lam, getLambda,
- smoothGel, solveGel, getImpProb)
+ solveGel, getImpProb, rhoETEL, rhoETHD)
### S3 methods ###
Modified: pkg/gmm4/R/allClasses.R
===================================================================
--- pkg/gmm4/R/allClasses.R 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/R/allClasses.R 2019-11-06 22:42:07 UTC (rev 151)
@@ -120,7 +120,6 @@
## Restricted gel Models
-
setClass("rlinearGel", representation(cstLHS="matrix", cstRHS="numeric", cstSpec="list"),
contains="linearGel")
@@ -222,6 +221,13 @@
survOptions=from at survOptions)
})
+setAs("linearGel", "nonlinearGel",
+ function(from) {
+ model <- as(as(from, "linearGmm"), "nonlinearGmm")
+ new("nonlinearGel", wSpec=from at wSpec, gelType=from at gelType, model)
+ })
+
+
setAs("linearGmm", "functionGmm",
function(from) {
spec <- modelDims(from)
@@ -244,6 +250,13 @@
centeredVcov=from at centeredVcov,omit=integer(),survOptions=from at survOptions)
})
+setAs("linearGel", "functionGel",
+ function(from) {
+ model <- as(as(from, "linearGmm"), "functionGmm")
+ new("functionGel", wSpec=from at wSpec, gelType=from at gelType, model)
+ })
+
+
setAs("allNLGmm", "functionGmm",
function(from) {
spec <- modelDims(from)
@@ -265,6 +278,18 @@
centeredVcov=from at centeredVcov,omit=integer(), survOptions=from at survOptions)
})
+setAs("nonlinearGel", "functionGel",
+ function(from) {
+ model <- as(as(from, "nonlinearGmm"), "functionGmm")
+ new("functionGel", wSpec=from at wSpec, gelType=from at gelType, model)
+ })
+
+setAs("formulaGel", "functionGel",
+ function(from) {
+ model <- as(as(from, "formulaGmm"), "functionGmm")
+ new("functionGel", wSpec=from at wSpec, gelType=from at gelType, model)
+ })
+
setAs("slinearGmm", "linearGmm",
function(from) {
spec <- modelDims(from)
Modified: pkg/gmm4/R/gel.R
===================================================================
--- pkg/gmm4/R/gel.R 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/R/gel.R 2019-11-06 22:42:07 UTC (rev 151)
@@ -31,6 +31,35 @@
-exp(gml))
}
+
+rhoETEL <- function(gmat, lambda, derive = 0, k = 1)
+{
+ lambda <- c(lambda)*k
+ gmat <- as.matrix(gmat)
+ gml <- c(gmat %*% lambda)
+ w <- -exp(gml)
+ w <- w/sum(w)
+ n <- nrow(gmat)
+ switch(derive+1,
+ -log(w*n),
+ NULL,
+ NULL)
+}
+
+rhoETHD <- function(gmat, lambda, derive = 0, k = 1)
+{
+ lambda <- c(lambda)*k
+ gmat <- as.matrix(gmat)
+ gml <- c(gmat %*% lambda)
+ w <- -exp(gml)
+ w <- w/sum(w)
+ n <- nrow(gmat)
+ switch(derive+1,
+ (sqrt(w)-1/sqrt(n))^2,
+ NULL,
+ NULL)
+}
+
rhoEEL <- function(gmat, lambda, derive = 0, k = 1)
{
lambda <- c(lambda)*k
@@ -89,15 +118,24 @@
}
EEL_lam <- function(gmat, k=1)
- {
- q <- qr(gmat)
- n <- nrow(gmat)
- lambda0 <- -qr.coef(q, rep(1,n))
- conv <- list(convergence=0)
- list(lambda = lambda0, convergence = conv, obj =
- mean(rhoEEL(gmat,lambda0,0,k)))
- }
+{
+ q <- qr(gmat)
+ n <- nrow(gmat)
+ lambda0 <- -qr.coef(q, rep(1,n))
+ conv <- list(convergence=0)
+ list(lambda = lambda0, convergence = conv,
+ obj = mean(rhoEEL(gmat,lambda0,0,k)))
+}
+ETXX_lam <- function(gmat, lambda0, k, gelType, algo, method, control)
+{
+ res <- getLambda(gmat, lambda0=lambda0, gelType="ET", algo=algo,
+ control=control, method=method, k=k)
+ rhoFct <- get(paste("rho",gelType,sep=""))
+ res$obj <- mean(rhoFct(gmat, res$lambda, 0, k))
+ res
+}
+
getLambda <- function (gmat, lambda0=NULL, gelType=NULL, rhoFct=NULL,
tol = 1e-07, maxiter = 100, k = 1, method="BFGS",
algo = c("nlminb", "optim", "Wu"), control = list())
@@ -122,16 +160,20 @@
return(EEL_lam(gmat, k))
if (gelType == "REEL")
return(REEL_lam(gmat, NULL, maxiter, k))
+ if (gelType %in% c("ETEL", "ETHD"))
+ return(ETXX_lam(gmat, lambda0, k, gelType, algo, method, control))
fct <- function(l, X, rhoFct, k) {
r0 <- rhoFct(X, l, derive = 0, k = k)
-mean(r0)
}
- Dfct <- function(l, X, rhoFct, k) {
+ Dfct <- function(l, X, rhoFct, k)
+ {
r1 <- rhoFct(X, l, derive = 1, k = k)
-colMeans(r1 * X)
}
- DDfct <- function(l, X, rhoFct, k) {
+ DDfct <- function(l, X, rhoFct, k)
+ {
r2 <- rhoFct(X, l, derive = 2, k = k)
-crossprod(X * r2, X)/nrow(X)
}
@@ -164,50 +206,3 @@
obj= mean(rhoFct(gmat,lambda0,0,k))))
}
-smoothGel <- function (object, theta=NULL)
-{
- if (inherits(object, "gelModels"))
- {
- gt <- evalMoment(as(object,"gmmModels"), theta)
- x <- kernapply(gt, object at wSpec$w)
- sx <- list(smoothx = x, w = object at wSpec$w,
- bw = object at wSpec$bw, k = object at wSpec$k)
- return(sx)
- }
- if (is.null(theta))
- theta <- modelFit(as(object, "gmmModels"), weights="ident")@theta
-
- gt <- evalMoment(object, theta)
- gt <- scale(gt, scale=FALSE)
- class(gt) <- "gmmFct"
- vspec <- object at vcovOptions
- if (!(vspec$kernel%in%c("Bartlett","Parzen")))
- object at vcovOptions$kernel <- "Bartlett"
- kernel <- switch(object at vcovOptions$kernel,
- Bartlett="Truncated",
- Parzen="Bartlett")
- k <- switch(kernel,
- Truncated=c(2,2),
- Bartlett=c(1,2/3))
- if (is.character(vspec$bw))
- {
- bw <- get(paste("bw", vspec$bw, sep = ""))
- bw <- bw(gt, kernel = vspec$kernel, prewhite = vspec$prewhite,
- ar.method = vspec$ar.method, approx = vspec$approx)
- } else {
- bw <- object at vcovOptions$bw
- }
- w <- weightsAndrews(gt, bw = bw, kernel = kernel, prewhite = vspec$prewhite,
- ar.method = vspec$ar.method, tol = vspec$tol, verbose = FALSE,
- approx = vspec$approx)
- rt <- length(w)
- if (rt >= 2)
- {
- w <- c(w[rt:2], w)
- w <- w/sum(w)
- w <- kernel(w[rt:length(w)])
- } else {
- w <- kernel(1)
- }
- return(list(k=k, w=w, bw=bw, kernel=kernel))
-}
Modified: pkg/gmm4/R/gelModels-methods.R
===================================================================
--- pkg/gmm4/R/gelModels-methods.R 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/R/gelModels-methods.R 2019-11-06 22:42:07 UTC (rev 151)
@@ -14,8 +14,14 @@
{
cat("Smoothing: ")
cat(x at wSpec$kernel, " kernel and ", sep="")
- cat(x at vcovOptions$bw, " bandwidth", sep="")
- cat(" (", round(x at wSpec$bw, 3), ")", sep="")
+ if (is.numeric(x at vcovOptions$bw))
+ {
+ cat("Fixed bandwidth (", round(x at vcovOptions$bw, 3), ")",
+ sep = "")
+ } else {
+ cat(x at vcovOptions$bw, " bandwidth", sep="")
+ cat(" (", round(x at wSpec$bw, 3), ")", sep="")
+ }
} else {
cat("No Smoothing required\n")
}
@@ -36,7 +42,7 @@
theta <- coef(object, theta)
evalMoment(as(object, "gmmModels"), theta)
} else {
- smoothGel(object, theta)$smoothx
+ kernapply(object, theta, TRUE)$smoothx
}
})
@@ -273,7 +279,62 @@
gmmToGel(as(object, "gmmModels"), gelType, rhoFct)
})
+## kernapply
+setGeneric("kernapply")
+setMethod("kernapply", "gelModels",
+ function(x, theta=NULL, smooth=TRUE, ...)
+ {
+ if (smooth) {
+ if (is.null(theta))
+ stop("theta0 is needed to compute the smoothed moments")
+ gt <- evalMoment(as(x,"gmmModels"), theta)
+ sx <- stats::kernapply(gt, x at wSpec$w)
+ ans <- list(smoothx = sx, w = x at wSpec$w,
+ bw = x at wSpec$bw, k = x at wSpec$k)
+ return(ans)
+ }
+ if (x at vcov != "HAC")
+ return(list(w=kernel(1), bw=1, k=c(1,1), kernel="none"))
+ if (is.null(theta))
+ theta <- modelFit(as(x, "gmmModels"), weights="ident")@theta
+ gt <- evalMoment(as(x, "gmmModels"), theta)
+ gt <- scale(gt, scale=FALSE)
+ class(gt) <- "gmmFct"
+ vspec <- x at vcovOptions
+ if (!(vspec$kernel%in%c("Bartlett","Parzen")))
+ x at vcovOptions$kernel <- "Bartlett"
+ kernel <- switch(x at vcovOptions$kernel,
+ Bartlett="Truncated",
+ Parzen="Bartlett")
+ k <- switch(kernel,
+ Truncated=c(2,2),
+ Bartlett=c(1,2/3))
+ if (is.character(vspec$bw))
+ {
+ bw <- get(paste("bw", vspec$bw, sep = ""))
+ bw <- bw(gt, kernel = vspec$kernel, prewhite = vspec$prewhite,
+ ar.method = vspec$ar.method, approx = vspec$approx)
+ } else {
+ bw <- x at vcovOptions$bw
+ }
+ w <- weightsAndrews(gt, bw = bw, kernel = kernel, prewhite = vspec$prewhite,
+ ar.method = vspec$ar.method, tol = vspec$tol,
+ verbose = FALSE, approx = vspec$approx)
+ rt <- length(w)
+ if (rt >= 2)
+ {
+ w <- c(w[rt:2], w)
+ w <- w/sum(w)
+ w <- kernel(w[rt:length(w)])
+ } else {
+ w <- kernel(1)
+ }
+ return(list(k=k, w=w, bw=bw, kernel=kernel))
+ })
+
+
+
Modified: pkg/gmm4/R/gmmModels-methods.R
===================================================================
--- pkg/gmm4/R/gmmModels-methods.R 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/R/gmmModels-methods.R 2019-11-06 22:42:07 UTC (rev 151)
@@ -946,10 +946,7 @@
function(object, gelType, rhoFct=NULL){
cls <- strsplit(class(object), "Gmm")[[1]][1]
cls <- paste(cls, "Gel", sep="")
- if (object at vcov == "HAC")
- wSpec <- smoothGel(object)
- else
- wSpec <- list(k=c(1,1), w=kernel(1), bw=1, kernel="None")
+ wSpec <- kernapply(object)
if (!is.null(rhoFct))
{
gelType <- "Other"
@@ -984,7 +981,13 @@
object
})
+## kernapply
+setMethod("kernapply", "gmmModels",
+ function(x, theta=NULL, ...)
+ {
+ getMethod("kernapply", "gelModels")(x, theta, FALSE)
+ })
Modified: pkg/gmm4/R/rGelModel-methods.R
===================================================================
--- pkg/gmm4/R/rGelModel-methods.R 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/R/rGelModel-methods.R 2019-11-06 22:42:07 UTC (rev 151)
@@ -1,26 +1,30 @@
-### restModel
+setMethod("restModel", signature("linearGel"),
+ function(object, R, rhs=NULL)
+ {
+ mod <- callNextMethod()
+ gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
+ })
-#setMethod("restModel", signature("linearGel"),
-# function(object, R, rhs=NULL)
-# {
-# mod <- getMethod("restModel", "linearGmm")(object, R, rhs)
-# new("rlinearGel", cstLHS=mod at cstLHS, cstRHS=mod at cstRHS,
-# cstSpec=mod at cstSpec, object)
-#})
-setMethod("restModel", signature("gelModels"),
+setMethod("restModel", signature("nonlinearGel"),
function(object, R, rhs=NULL)
{
mod <- callNextMethod()
- gmmToGel(mod, object at gelType$name, object at getType$rhoFct)
+ gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
})
-##setMethod("restModel", signature("nonlinearGel"),
-## function(object, R, rhs=NULL)
-## {
-## mod <- getMethod("restModel", "nonlinearGmm")(object, R, rhs)
-## new("rnonlinearGel", R=mod at R, cstSpec=mod at cstSpec, object)
-## })
+setMethod("restModel", signature("formulaGel"),
+ function(object, R, rhs=NULL)
+ {
+ mod <- callNextMethod()
+ gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
+ })
+setMethod("restModel", signature("functionGel"),
+ function(object, R, rhs=NULL)
+ {
+ mod <- callNextMethod()
+ gmmToGel(mod, object at gelType$name, object at gelType$rhoFct)
+ })
## printRestrict
Modified: pkg/gmm4/R/validity.R
===================================================================
--- pkg/gmm4/R/validity.R 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/R/validity.R 2019-11-06 22:42:07 UTC (rev 151)
@@ -528,68 +528,69 @@
.checkGelModels <- function(object)
+{
+ error <- character()
+ if (!all(names(object at wSpec)%in%c("k","w","bw","kernel")))
{
- error <- character()
- if (!all(names(object at wSpec)%in%c("k","w","bw","kernel")))
+ msg <- "wSpec must be a list with k, w, bw, and kernel"
+ error <- c(error, msg)
+ } else {
+ s <- object at wSpec
+ if (!is.numeric(s$bw))
+ {
+ msg <- "bw must be numeric"
+ error <- c(error, msg)
+ }
+ if (class(s$w) != "tskernel")
+ {
+ msg <- "w must be an object of class 'tskernel'"
+ error <- c(error, msg)
+ }
+ if (!is.character(s$kernel))
+ {
+ msg <- "kernel must be a character"
+ error <- c(error, msg)
+ }
+ }
+ if (!all(names(object at gelType)%in%c("name","fct")))
+ {
+ msg <- "gelType must be a list with name and fct"
+ error <- c(error, msg)
+ } else {
+ gtype <- object at gelType
+ if (!is.character(gtype$name))
+ {
+ error <- c(error, "name in gelType must ba a character")
+ } else {
+ if (is.null(gtype$fct))
{
- msg <- "wSpec must be a list with k, w, bw, and kernel"
- error <- c(error, msg)
+ if (!(gtype$name %in% c("EL","ET","EEL","HD","REEL",
+ "ETEL","ETHD")))
+ {
+ msg <- "name in gelType must be ET, ETEL, EL, ETHD, HD, EEL or REEL"
+ error <- c(error, msg)
+ }
} else {
- s <- object at wSpec
- if (!is.numeric(s$bw))
+ if (!is.function(gtype$fct))
+ {
+ msg <- "fct in getType must be a function"
+ error <- c(error, msg)
+ } else {
+ n <- names(formals(gtype$fct))
+ tn <- c("gmat", "lambda", "derive", "k")
+ if (!isTRUE(all.equal(n, tn)))
{
- msg <- "bw must be numeric"
+ msg <- "rhoFct must have the four arguments gmat, lambda, derive and k"
error <- c(error, msg)
}
- if (class(s$w) != "tskernel")
- {
- msg <- "w must be an object of class 'tskernel'"
- error <- c(error, msg)
- }
- if (!is.character(s$kernel))
- {
- msg <- "kernel must be a character"
- error <- c(error, msg)
- }
+ }
}
- if (!all(names(object at gelType)%in%c("name","fct")))
- {
- msg <- "gelType must be a list with name and fct"
- error <- c(error, msg)
- } else {
- gtype <- object at gelType
- if (!is.character(gtype$name))
- {
- error <- c(error, "name in gelType must ba a character")
- } else {
- if (is.null(gtype$fct))
- {
- if (!(gtype$name %in% c("EL","ET","EEL","HD","REEL")))
- {
- msg <- "name in gelType must be ET, EL, HD, EEL or REEL"
- error <- c(error, msg)
- }
- } else {
- if (!is.function(gtype$fct))
- {
- msg <- "fct in getType must be a function"
- error <- c(error, msg)
- } else {
- n <- names(formals(gtype$fct))
- tn <- c("gmat", "lambda", "derive", "k")
- if (!isTRUE(all.equal(n, tn)))
- {
- msg <- "rhoFct must have the four arguments gmat, lambda, derive and k"
- error <- c(error, msg)
- }
- }
- }
- }
- }
- if (length(error)==0)
- TRUE
- else
- error
+ }
}
+ if (length(error)==0)
+ TRUE
+ else
+ error
+}
setValidity("gelModels", .checkGelModels)
Added: pkg/gmm4/man/kernapply-methods.Rd
===================================================================
--- pkg/gmm4/man/kernapply-methods.Rd (rev 0)
+++ pkg/gmm4/man/kernapply-methods.Rd 2019-11-06 22:42:07 UTC (rev 151)
@@ -0,0 +1,85 @@
+\name{kernapply-methods}
+\docType{methods}
+\alias{kernapply}
+\alias{kernapply-methods}
+\alias{kernapply,gelModels-method}
+\alias{kernapply,gmmModels-method}
+
+\title{A kernel smoothing utility for \code{"gelModels"} classes}
+
+\description{
+It either generates the optimal bandwidth and kernel
+weights or the smoothed moments of GEL models.
+}
+
+\usage{
+\S4method{kernapply}{gelModels}(x, theta=NULL, smooth=TRUE, \dots)
+
+\S4method{kernapply}{gmmModels}(x, theta=NULL, \dots)
+}
+
+\arguments{
+ \item{x}{An object of class \code{"gelModels"}.}
+
+ \item{theta}{An optional vector of coefficients. For
+ \code{smooth=FALSE}, it is used to obtain the optimal bandwidth. If
+ \code{NULL}, the bandwidth is obtained using one step GMM with the
+ identity matrix as weights. For \code{smooth=TRUE}, the coefficient is
+ required since the function returns the smoothed moments at a given
+ vector of coefficients.}
+ \item{smooth}{By default, it returns the smoothed moment matrix. If
+ \code{FALSE}, it computes the optimal bandwidth and kernel weights.}
+ \item{\dots}{Other arguments to pass. Currently not used}
+}
+
+\value{
+ A list which contains:
+
+ \item{k}{\eqn{2\times 1} vector of scaling factors used for GEL
+ asymptotics. See Anatolyev (2005).}
+
+ \item{w}{The kernel weights as an object of class "tskernel". See
+ \code{\link{kernel}}.}
+
+ \item{bw}{A numeric bandwidth.}
+
+ \item{kernel}{A character specifying th type of kernel used for smoothing}
+
+ \item{smoothx}{Only when \code{smooth=TRUE}, a
+ matrix of smoothed moments}
+}
+
+\references{ Anatolyev, S. (2005), GMM, GEL, Serial Correlation, and
+Asymptotic Bias. \emph{Econometrica}, \bold{73}, 983-1002.
+
+Kitamura, Yuichi (1997), Empirical Likelihood Methods With Weakly Dependent Processes.
+\emph{The Annals of Statistics}, \bold{25}, 2084-2102.
+
+Smith, R.J. (2011), GEL Criteria for Moment Condition Models.
+\emph{Econometric Theory}, \bold{27}(6), 1192--1235.
+}
+
+\examples{
+data(simData)
+theta <- c(beta0=1,beta1=2)
+
+## A linearGmm
+model1 <- gmmModel(y~x1, ~z1+z2, data=simData,vcov="HAC",vcovOptions=list(kernel="Bartlett"))
+
+### get the bandwidth
+### Notice that the kernel name is the not the same
+### That's because a Truncated kernel for smoothing
+### lead to a Bartlett kernel for the HAC of the moments
+### See Smith (2011)
+kernapply(model1, smooth=FALSE)
+
+
+### The GEL model contains the info when it is created
+
+model2 <- gmmToGel(model1, "EL")
+model2 at wSpec
+
+kernapply(model2, theta)$smoothx[1:5,]
+
+}
+
Modified: pkg/gmm4/man/lambdaAlgo.Rd
===================================================================
--- pkg/gmm4/man/lambdaAlgo.Rd 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/man/lambdaAlgo.Rd 2019-11-06 22:42:07 UTC (rev 151)
@@ -3,6 +3,7 @@
\alias{Wu_lam}
\alias{EEL_lam}
\alias{REEL_lam}
+\alias{ETXX_lam}
\alias{getLambda}
\title{Algorithms to solve for the Lagrange multiplier}
@@ -18,6 +19,8 @@
REEL_lam(gmat, tol=NULL, maxiter=50, k=1)
+ETXX_lam(gmat, lambda0, k, gelType, algo, method, control)
+
getLambda(gmat, lambda0=NULL, gelType=NULL, rhoFct=NULL,
tol = 1e-07, maxiter = 100, k = 1, method="BFGS",
algo = c("nlminb", "optim", "Wu"), control = list())
@@ -61,6 +64,10 @@
}
+\details{The \code{ETXX_lam} is used for ETEL and ETHD. In general, it
+ computes lambda using ET, and returns the value of the objective
+ function determined by the \code{gelType}. }
+
\references{
Anatolyev, S. (2005), GMM, GEL, Serial Correlation, and Asymptotic Bias. \emph{Econometrica}, \bold{73}, 983-1002.
Modified: pkg/gmm4/man/restModel-methods.Rd
===================================================================
--- pkg/gmm4/man/restModel-methods.Rd 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/man/restModel-methods.Rd 2019-11-06 22:42:07 UTC (rev 151)
@@ -3,11 +3,15 @@
\alias{restModel}
\alias{restModel-methods}
\alias{restModel,linearGmm-method}
-\alias{restModel,gelModels-method}
\alias{restModel,formulaGmm-method}
\alias{restModel,slinearGmm-method}
\alias{restModel,nonlinearGmm-method}
\alias{restModel,functionGmm-method}
+\alias{restModel,linearGel-method}
+\alias{restModel,formulaGel-method}
+\alias{restModel,nonlinearGel-method}
+\alias{restModel,functionGel-method}
+
\title{ ~~ Methods for Function \code{restModel} in Package \pkg{gmm4} ~~}
\description{
It creates \code{gmmModels} class of objects with linear restrictions on the coefficients.
@@ -15,11 +19,22 @@
\usage{
\S4method{restModel}{linearGmm}(object, R, rhs=NULL)
+\S4method{restModel}{linearGel}(object, R, rhs=NULL)
+
\S4method{restModel}{slinearGmm}(object, R, rhs=NULL)
\S4method{restModel}{nonlinearGmm}(object, R, rhs=NULL)
-\S4method{restModel}{gelModels}(object, R, rhs=NULL)
+\S4method{restModel}{nonlinearGel}(object, R, rhs=NULL)
+
+\S4method{restModel}{formulaGmm}(object, R, rhs=NULL)
+
+\S4method{restModel}{functionGmm}(object, R, rhs=NULL)
+
+\S4method{restModel}{formulaGel}(object, R, rhs=NULL)
+
+\S4method{restModel}{functionGel}(object, R, rhs=NULL)
+
}
\arguments{
\item{object}{An object of class \code{"gmmModels"} or \code{"gelModels"}.}
@@ -35,25 +50,37 @@
Method for object of class \code{linearGmm}.
}
-\item{\code{signature(object = "gelModels")}}{
- Method for all classes related to \code{gelModels}.
+\item{\code{signature(object = "linearGel")}}{
+ Method for all classes related to \code{linearGel}.
}
-\item{\code{signature(object = "linearGmm")}}{
+\item{\code{signature(object = "slinearGmm")}}{
Method for object of class \code{slinearGmm}.
}
\item{\code{signature(object = "nonlinearGmm")}}{
-Method for object of class \code{linearGmm}.
+Method for object of class \code{nonlinearGmm}.
}
+\item{\code{signature(object = "nonlinearGel")}}{
+Method for object of class \code{nonlinearGel}.
+}
+
\item{\code{signature(object = "functionGmm")}}{
-Method for object of class \code{linearGmm}.
+Method for object of class \code{functionGmm}.
}
+\item{\code{signature(object = "functionGel")}}{
+Method for object of class \code{functionGel}.
+}
+
\item{\code{signature(object = "formulaGmm")}}{
Method for object of class \code{formulaGmm}.
}
+
+\item{\code{signature(object = "formulaGel")}}{
+Method for object of class \code{formulaGel}.
+}
}}
\examples{
data(simData)
Modified: pkg/gmm4/man/rhoFct.Rd
===================================================================
--- pkg/gmm4/man/rhoFct.Rd 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/man/rhoFct.Rd 2019-11-06 22:42:07 UTC (rev 151)
@@ -5,6 +5,8 @@
\alias{rhoEEL}
\alias{rhoREEL}
\alias{rhoHD}
+\alias{rhoETHD}
+\alias{rhoETEL}
\title{GEL objective functions}
@@ -15,6 +17,8 @@
\usage{
rhoET(gmat, lambda, derive = 0, k = 1)
+rhoETEL(gmat, lambda, derive = 0, k = 1)
+
rhoEL(gmat, lambda, derive = 0, k = 1)
rhoEEL(gmat, lambda, derive = 0, k = 1)
@@ -21,7 +25,9 @@
rhoREEL(gmat, lambda, derive = 0, k = 1)
-rhoHD(gmat, lambda, derive = 0, k = 1)
+rhoHD(gmat, lambda, derive = 0, k = 1)
+
+rhoETHD(gmat, lambda, derive = 0, k = 1)
}
\arguments{
\item{gmat}{The \eqn{n \times q} matrix of moments}
Deleted: pkg/gmm4/man/smoothGel.Rd
===================================================================
--- pkg/gmm4/man/smoothGel.Rd 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/man/smoothGel.Rd 2019-11-06 22:42:07 UTC (rev 151)
@@ -1,77 +0,0 @@
-\name{smoothGel}
-
-\alias{smoothGel}
-
-\title{A kernel smoothing utility for \code{"gmmModels"} classes}
-
-\description{
-It either generates the optimal bandwidth and kernel weights when the
-object is a GMM model, or the smoothed moments when the object is a GEL
-model.
-}
-\usage{
-smoothGel(object, theta=NULL)
-}
-\arguments{
- \item{object}{An object of class \code{"gmmModels"} or
- \code{"gelModels"}.}
-
- \item{theta}{An optional vector of coefficients. For
- \code{"gmmModels"}, it is the coefficient used to obtain the optimal
- bandwidth. If \code{NULL}, it is obtained using \code{\link{modelFit}}
- with the identity matrix as weights. For \code{"gelModels"}, the
- coefficient is require since the function returns the smoothed moments
- at a given vector of coefficients.}
-}
-
-\value{
- A list which contains:
-
- \item{k}{\eqn{2\times 1} vector of scaling factors used for GEL
- asymptotics. See Anatolyev (2005).}
-
- \item{w}{The kernel weights as an object of class "tskernel". See
- \code{\link{kernapply}}.}
-
- \item{bw}{A numeric bandwidth.}
-
- \item{kernel}{A character specifying th type of kernel used for smoothing}
-
- \item{smoothx}{Only when the object is of class \code{"gelModels"}, a
- matrix of smoothed moments}
-}
-
-\references{
-Anatolyev, S. (2005), GMM, GEL, Serial Correlation, and Asymptotic Bias. \emph{Econometrica}, \bold{73}, 983-1002.
-
-Kitamura, Yuichi (1997), Empirical Likelihood Methods With Weakly Dependent Processes.
-\emph{The Annals of Statistics}, \bold{25}, 2084-2102.
-
-Smith, R.J. (2011), GEL Criteria for Moment Condition Models.
-\emph{Econometric Theory}, \bold{27}(6), 1192--1235.
-}
-
-\examples{
-data(simData)
-theta <- c(beta0=1,beta1=2)
-
-## A linearGmm
-model1 <- gmmModel(y~x1, ~z1+z2, data=simData,vcov="HAC",vcovOptions=list(kernel="Bartlett"))
-
-### get the bandwidth
-### Notice that the kernel name is the not the same
-### That's because a Truncated kernel for smoothing
-### lead to a Bartlett kernel for the HAC of the moments
-### See Smith (2011)
-smoothGel(model1)
-
-
-### The GEL model contains the info when it is created
-
-model2 <- gmmToGel(model1, "EL")
-model2 at wSpec
-
-smoothGel(model2, theta)$smoothx[1:5,]
-
-}
-
Modified: pkg/gmm4/vignettes/gelS4.Rnw
===================================================================
--- pkg/gmm4/vignettes/gelS4.Rnw 2019-11-04 22:30:08 UTC (rev 150)
+++ pkg/gmm4/vignettes/gelS4.Rnw 2019-11-06 22:42:07 UTC (rev 151)
@@ -279,7 +279,7 @@
implied probabilities. In that case, the maxiter can be used to
control the number of iterations.
-\item: Others: When rhoFct is provided or the type is ET, the solution
+\item Others: When rhoFct is provided or the type is ET, the solution
is obtained by either ``nlminb'' or ``optim''. In that case, the
algorithms are controlled through the control argument.
\end{itemize}
@@ -303,6 +303,8 @@
res$convergence$convergence
@
+The following shows that we can provide getLambda() with a rhoFct instead:
+
<<>>=
(res <- getLambda(X, rhoFct=rhoEEL))$lambda
res$convergence$convergence
@@ -314,6 +316,319 @@
\section{Methods for gelModels Classes} \label{sec:gelmodels-methods}
+We saw above that any ``gelModels'' is a class that contains one of
+the ``gmmModels'' class object. Therefore, many ``gmmModels'' methods
+can be applied to ``gelModels'' through this direct inheritance. when
+it is the case, we will specify ``gmmModels inherited method''.
+
+
+\begin{itemize}
+\item \textit{kernapply}: In the case of weakly dependent moment
+ conditions, we saw above that the moment function must be smoothed
+ using the following expression:
+\[
+g^w_t(\theta) = \sum_{s=-m}^m w(s)g_{t-s}(\theta)
+\]
+
+When a GEL model is defined with vcov="HAC", the specification of the
+kernel is stored in the ``wSpec'' slot of the object. For example, we
+can define the linear model above with the HAC specification:
+
+<<>>=
+linHAC <- gelModel(y~x1+x2, ~x2+z1+z2, data=simData, vcov="HAC", gelType="EL")
+linHAC
+@
+
+The optimal bandwidth is computed when the model is created, and
+remains the same during the estimation process, unless another one is
+specified. The above model shows that the default kernel is the
+``Truncated'' one, and the default bandwidth is based on
+\cite{andrews91}. The bandwidth is not based on the smoothing kernel,
+but on the implied kernel for the HAC estimation. \cite{smith01} shows
+that when $g_t(\theta)$ is replaced by $g^w_t(\theta)$,
+$V=\sum_{i=1}^n g^w_t(\theta)g^w_t(\theta)'/n$ is an HAC estimator of
+the covariance matrix of $\sqrt{n}\bar{g}(\theta)$, with Bartlett
+kernel when the smoothing kernel is the Truncated, and with Parzen
+kernel when the smoothing kernel is the Bartlett. The optimal bandwidth
+above is therefore based on the Bartlett kernel.
+
+It is possible to modify the specifications of the kernel and
+bandwidth through the argument vcovOptions (See help(vcovHAC) from the
+sandwich package for all possible options). Notice that the kernel
+type that is passed is the kernel used for the HAC estimation, not the
+smoothing of $g_t(\theta)$. See in the following example that the
+Parzen kernel is selected, which implies a Bartlett kernel for the
+smoothing of $g_t(\theta)$.
+
+<<>>=
+linHAC2 <- gelModel(y~x1+x2, ~x2+z1+z2, data=simData, vcov="HAC",
+ gelType="EL",
+ vcovOptions=list(kernel="Parzen", bw="NeweyWest", prewhite=1))
+linHAC2
+@
+
+It is also possible to set the bandwidth to a fix number:
+
+<<>>=
+linHAC3 <- gelModel(y~x1+x2, ~x2+z1+z2, data=simData, vcov="HAC",
+ gelType="EL",
+ vcovOptions=list(kernel="Parzen", bw=3, prewhite=1))
+linHAC3
+@
+
+The \textit{kernapply} method, which is defined as an S3 method in the
+stats package, uses the information contained in the ``wSpec'' slot to
+compute the $n\times q$ matrix of moment with the i$^{th}$ row being
+$g_t^w(\theta)'$. A theta is required, because we need to evaluate
+$g_t(\theta)$.
+
+<<>>=
+gw <- kernapply(linHAC, theta=c(1,1,1))$smoothx
+head(gw)
+@
+
+The function also returns the weights, bandwidth, kernel name and the
+scalars $k_1$ and $k_2$ that are needed for the asymptotic properties
+of the estimators (see \cite{anatolyev05}). If the argument
+smooth is set to FALSE, the optimal bandwidth is computed and no
+smoothing is done. By default, the first step GMM estimator with the
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/gmm -r 151
More information about the Gmm-commits
mailing list