[Gmm-commits] r82 - in pkg/gmm: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 27 21:55:24 CET 2015
Author: chaussep
Date: 2015-10-27 21:55:24 +0100 (Tue, 27 Oct 2015)
New Revision: 82
Modified:
pkg/gmm/NAMESPACE
pkg/gmm/R/gel.R
pkg/gmm/R/getModel.R
pkg/gmm/R/momentEstim.R
pkg/gmm/man/gel.Rd
pkg/gmm/man/gmm.Rd
pkg/gmm/man/momentEstim.Rd
Log:
More change, see NEWS
Modified: pkg/gmm/NAMESPACE
===================================================================
--- pkg/gmm/NAMESPACE 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/NAMESPACE 2015-10-27 20:55:24 UTC (rev 82)
@@ -11,7 +11,8 @@
momentEstim.baseGmm.iterative.formula, momentEstim.baseGmm.iterative, momentEstim.baseGmm.cue.formula,
momentEstim.baseGmm.cue, getModel.baseGmm, getModel.baseGel, getModel.constGmm, getModel.constGel,
FinRes.baseGmm.res, momentEstim.baseGel.mod, momentEstim.baseGel.modFormula,tsls,summary.tsls, print.summary.tsls,
- KTest, print.gmmTests, gmmWithConst, estfun.tsls, model.matrix.tsls,vcov.tsls, bread.tsls, evalGmm, momentEstim.baseGmm.eval)
+ KTest, print.gmmTests, gmmWithConst, estfun.tsls, model.matrix.tsls,vcov.tsls, bread.tsls, evalGmm, momentEstim.baseGmm.eval,
+ momentEstim.baseGel.eval, evalGel)
S3method(summary, gmm)
S3method(summary, tsls)
@@ -54,6 +55,7 @@
S3method(momentEstim, baseGmm.cue)
S3method(momentEstim, baseGel.mod)
S3method(momentEstim, baseGel.modFormula)
+S3method(momentEstim, baseGel.eval)
S3method(estfun, gmmFct)
S3method(estfun, gmm)
S3method(estfun, tsls)
Modified: pkg/gmm/R/gel.R
===================================================================
--- pkg/gmm/R/gel.R 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/R/gel.R 2015-10-27 20:55:24 UTC (rev 82)
@@ -254,7 +254,37 @@
return(z)
}
+evalGel <- function(g, x, tet0, gradv = NULL, smooth = FALSE, type = c("EL", "ET", "CUE", "ETEL", "HD", "ETHD"),
+ kernel = c("Truncated", "Bartlett"), bw = bwAndrews, approx = c("AR(1)", "ARMA(1,1)"),
+ prewhite = 1, ar.method = "ols", tol_weights = 1e-7, tol_lam = 1e-9, tol_obj = 1e-9,
+ tol_mom = 1e-9, maxiterlam = 100, optlam = c("nlminb", "optim", "iter"), data, Lambdacontrol = list(),
+ model = TRUE, X = FALSE, Y = FALSE, alpha = NULL, ...)
+ {
+ type <- match.arg(type)
+ optlam <- match.arg(optlam)
+ weights <- weightsAndrews
+ approx <- match.arg(approx)
+ kernel <- match.arg(kernel)
+ TypeGel <- "baseGel"
+
+ if(missing(data))
+ data<-NULL
+ all_args <- list(g = g, x = x, tet0 = tet0, gradv = gradv, smooth = smooth, type = type,
+ kernel = kernel, bw = bw, approx = approx, prewhite = prewhite, ar.method = ar.method,
+ tol_weights = tol_weights, tol_lam = tol_lam, tol_obj = tol_obj, tol_mom = tol_mom,
+ maxiterlam = maxiterlam, weights = weights, optlam = optlam, model = model, X = X,
+ Y = Y, call = match.call(), Lambdacontrol = Lambdacontrol, alpha = alpha, data = data,
+ optfct="optim")
+
+ class(all_args)<-TypeGel
+ Model_info<-getModel(all_args)
+ class(Model_info) <- "baseGel.eval"
+ z <- momentEstim(Model_info, ...)
+ class(z) <- "gel"
+ return(z)
+ }
+
.thetf <- function(tet, P, output=c("obj","all"), l0Env)
{
output <- match.arg(output)
Modified: pkg/gmm/R/getModel.R
===================================================================
--- pkg/gmm/R/getModel.R 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/R/getModel.R 2015-10-27 20:55:24 UTC (rev 82)
@@ -215,12 +215,16 @@
if (dat$ny > 1)
{
namey <- colnames(dat$x[,1:dat$ny])
- object$namesCoef <- paste(rep(namey, dat$k), "_", rep(namex, rep(dat$ny, dat$k)), sep = "")
+ namesCoef <- paste(rep(namey, dat$k), "_", rep(namex, rep(dat$ny, dat$k)), sep = "")
object$namesgt <- paste(rep(namey, dat$nh), "_", rep(nameh, rep(dat$ny, dat$nh)), sep = "")
} else {
- object$namesCoef <- namex
+ namesCoef <- namex
object$namesgt <- nameh
}
+ if (is.null(names(object$tet0)))
+ object$namesCoef <- namesCoef
+ else
+ object$namesCoef <- names(object$tet0)
attr(object$x,"ModelType") <- "linear"
attr(object$x, "k") <- k
attr(object$x, "q") <- object$x$ny*object$x$nh
Modified: pkg/gmm/R/momentEstim.R
===================================================================
--- pkg/gmm/R/momentEstim.R 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/R/momentEstim.R 2015-10-27 20:55:24 UTC (rev 82)
@@ -728,7 +728,7 @@
gt <- All$gt
rlamb <- All$lambda
- z <- list(coefficients = res$par, lambda = rlamb$lambda, conv_lambda = rlamb$conv, conv_par = res$convergence, dat=P$dat)
+ z <- list(coefficients = res$par, lambda = rlamb$lambda, conv_lambda = rlamb$conv, conv_par = res$convergence, dat=x)
z$type <- P$type
z$gt <- gt
@@ -940,3 +940,74 @@
return(z)
}
+momentEstim.baseGel.eval <- function(object, ...)
+ {
+ P <- object
+ q <- attr(P$x, "q")
+ n <- attr(P$x, "n")
+ l0Env <- new.env()
+ assign("l0",rep(0,q),envir=l0Env)
+ All <- .thetf(P$tet0, P, "all",l0Env = l0Env)
+ gt <- All$gt
+ rlamb <- All$lambda
+ z <- list(coefficients = P$tet0, lambda = rlamb$lambda, conv_lambda = rlamb$conv, conv_par = NULL, dat=P$x)
+
+ z$type <- P$type
+ z$gt <- gt
+ pt <- .getImpProb(z$gt, z$lambda, P$type, P$k1, P$k2)
+ z$pt <- c(pt)
+ z$conv_moment <- attr(pt, "conv_moment")
+ z$conv_pt <- attr(pt, "conv_pt")
+ z$objective <- All$obj
+ z$call <- P$call
+ z$k1 <- P$k1
+ z$k2 <- P$k2
+ z$CGEL <- P$CGEL
+ z$typeDesc <- P$typeDesc
+ z$specMod <- P$specMod
+ names(z$coefficients) <- P$namesCoef
+ if (!is.null(object$namesgt))
+ {
+ colnames(z$gt) <- object$namesgt
+ } else {
+ colnames(z$gt) <- paste("g",1:ncol(z$gt), sep="")
+ }
+ names(z$lambda) <- paste("Lam(", colnames(z$gt), ")", sep="")
+ if(P$gradvf)
+ G <- P$gradv(z$coefficients, P$x)
+ else
+ G <- P$gradv(z$coefficients, P$x, z$pt)
+ khat <- crossprod(c(z$pt)*z$gt,z$gt)/(P$k2)*P$bwVa
+
+ G <- G/P$k1
+ kg <- solve(khat, G)
+ z$vcov_par <- solve(crossprod(G, kg))/n
+ if (length(z$lambda) == length(z$coefficients))
+ {
+ z$vcov_lambda <- matrix(NA, rep(length(z$lambda), 2))
+ z$lambda <- rep(NA, length(z$lambda))
+ z$specMod <- paste(z$specMod, "\n Just identified model; no lambda nor specification test needed\n", sep="")
+ } else {
+ z$vcov_lambda <- solve(khat, ( diag(ncol(khat)) - G %*% (z$vcov_par*n) %*% t(kg) ))/n*P$bwVal^2
+ }
+
+ z$weights <- P$w
+ z$bwVal <- P$bwVal
+ names(z$bwVal) <- "Bandwidth"
+ dimnames(z$vcov_par) <- list(names(z$coefficients), names(z$coefficients))
+ dimnames(z$vcov_lambda) <- list(names(z$lambda), names(z$lambda))
+ if (attr(P$x,"ModelType") == "linear")
+ {
+ tmp <- .residuals(z$coefficients, P$x)
+ z$fitted.values <- tmp$yhat
+ z$residuals <- tmp$residuals
+ z$terms <- P$x$mt
+ if(P$model) z$model <- P$x$mf
+ if(P$X) z$x <- as.matrix(P$x$x[,(P$x$ny+1):(P$x$ny+P$x$k)])
+ if(P$Y) z$y <- as.matrix(P$x$x[,1:P$x$ny])
+ }
+ z$khat <- khat
+ return(z)
+ }
+
+
Modified: pkg/gmm/man/gel.Rd
===================================================================
--- pkg/gmm/man/gel.Rd 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/man/gel.Rd 2015-10-27 20:55:24 UTC (rev 82)
@@ -1,6 +1,7 @@
\name{gel}
\alias{gel}
+\alias{evalGel}
\title{Generalized Empirical Likelihood estimation}
@@ -18,6 +19,14 @@
Lambdacontrol = list(), model = TRUE, X = FALSE, Y = FALSE,
TypeGel = "baseGel", alpha = NULL, eqConst = NULL,
eqConstFullVcov = FALSE, ...)
+evalGel(g, x, tet0, gradv = NULL, smooth = FALSE,
+ type = c("EL", "ET", "CUE", "ETEL", "HD", "ETHD"),
+ kernel = c("Truncated", "Bartlett"), bw = bwAndrews,
+ approx = c("AR(1)", "ARMA(1,1)"), prewhite = 1,
+ ar.method = "ols", tol_weights = 1e-7, tol_lam = 1e-9, tol_obj = 1e-9,
+ tol_mom = 1e-9, maxiterlam = 100, optlam = c("nlminb", "optim",
+ "iter"), data, Lambdacontrol = list(), model = TRUE, X = FALSE,
+ Y = FALSE, alpha = NULL, ...)
}
\arguments{
\item{g}{A function of the form \eqn{g(\theta,x)} and which returns a \eqn{n \times q} matrix with typical element \eqn{g_i(\theta,x_t)} for \eqn{i=1,...q} and \eqn{t=1,...,n}. This matrix is then used to build the q sample moment conditions. It can also be a formula if the model is linear (see details below). }
@@ -94,8 +103,15 @@
The method solves
\eqn{\hat{\theta} = \arg\min \left[\arg\max_\lambda \frac{1}{n}\sum_{t=1}^n \rho(<g(\theta,x_t),\lambda>) - \rho(0) \right]}
- }
+\code{\link{evalGel}} generates the object of class "gel" for a fixed vector of
+parameters. There is no estimation for \eqn{\theta}, but the optimal
+vector of Lagrange multipliers \eqn{\lambda} is computed. The objective
+function is then the profiled likelihood for a given \eqn{\theta}. It
+can be used to construct a confidence interval by inverting the
+likelihood ratio test.
+}
+
\value{
'gel' returns an object of 'class' '"gel"'
@@ -221,5 +237,9 @@
res <- gel(g, x, c(0, .3, .6))
summary(res)
+# Using evalGel to create the object without estimation
+
+res <- evalGel(g, x, res$coefficients)
+
}
Modified: pkg/gmm/man/gmm.Rd
===================================================================
--- pkg/gmm/man/gmm.Rd 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/man/gmm.Rd 2015-10-27 20:55:24 UTC (rev 82)
@@ -338,6 +338,12 @@
gmmWithConst(res2,c("f2","f3"),c(.5,.5))
gmmWithConst(res2,c(2,3),c(.5,.5))
+## Creating an object without estimation for a fixed parameter vector
+###################################################################
+res2_2 <- evalGmm(z ~ f1 + f2 + f3, ~ f1 + f2 + f3,
+ t0=res2$coefficients, tetw=res2$coefficients)
+summary(res2_2)
+
}
Modified: pkg/gmm/man/momentEstim.Rd
===================================================================
--- pkg/gmm/man/momentEstim.Rd 2015-10-27 17:46:15 UTC (rev 81)
+++ pkg/gmm/man/momentEstim.Rd 2015-10-27 20:55:24 UTC (rev 82)
@@ -8,6 +8,7 @@
\alias{momentEstim.baseGmm.eval}
\alias{momentEstim.baseGel.mod}
\alias{momentEstim.baseGel.modFormula}
+\alias{momentEstim.baseGel.eval}
\title{Method for estimating models based on moment conditions}
\description{
It estimates a model which is caracterized by the method \code{getModel} (see details).
@@ -22,6 +23,7 @@
\method{momentEstim}{baseGmm.eval}(object, ...)
\method{momentEstim}{baseGel.mod}(object, ...)
\method{momentEstim}{baseGel.modFormula}(object, ...)
+\method{momentEstim}{baseGel.eval}(object, ...)
}
\arguments{
\item{object}{An object created by the method \code{getModel}}
More information about the Gmm-commits
mailing list