Nothing
################## Constructor for the sysGmmModels classes #####################
sysGmmModel <- function(g, h=NULL, theta0=NULL,
vcov = c("iid", "HAC", "MDS", "CL"),
vcovOptions=list(), centeredVcov = TRUE, data=parent.frame(),
na.action="na.omit", survOptions=list())
{
vcov <- match.arg(vcov)
if (!is.list(vcovOptions) | !is.list(survOptions))
stop("vcovOptions and survOptions must be a list")
vcovOptions <- .getVcovOptions(vcov, data, vcovOptions)
survOptions <- .getSurvOptions(data, survOptions)
if (!is.list(data) && !is.environment(data))
stop("'data' must be a list or an environment")
if (!is.list(g))
stop("For system GMM, g must be lists of formulas")
clg <- sapply(g, class)
if (!all(clg=="formula"))
stop("For system GMM, g must be lists of formulas")
if (length(g) == 1)
stop("There is only one equation. Use gmmModel() instead")
## Try to see if parameters are in formulas
if (!is.null(theta0))
{
if (!is.list(theta0))
stop("For system GMM, theta0 must be a list of named vectors")
if (length(theta0) != length(g))
stop("The length of theta0 must match the length of g and h")
chk <- sapply(1:length(theta0),
function(i) isTRUE(all(names(theta0[[i]]) %in% all.vars(g[[i]]))))
if (all(chk))
{
nonlin <- TRUE
chk2 <- sapply(theta0[-1],
function(l) any(names(l) %in% names(theta0[[1]])))
if (any(chk2))
stop("Coefficient names across equations must be different")
} else if (all(!chk)){
nonlin <- FALSE
} else {
stop("g must all be linear or all nonlinear")
}
} else {
nonlin <- FALSE
}
varg <- lapply(1:length(g), function(i) .formSpec(g[[i]], theta0[[i]]))
if (is.null(h))
{
SUR <- TRUE
sameMom <- TRUE
anyEndo <- rep(FALSE, length(g))
chk <- sapply(varg, function(v) length(v$lhs)==0)
if (any(chk))
stop("For SUR, there must be a LHS")
reg <- lapply(1:length(g), function(i) varg[[i]]$rhs)
reg <- unique(do.call("c", reg))
if (!nonlin)
intercept <- any(sapply(varg, function(v) v$intercept == 1))
else
intercept <- TRUE
reg <- paste(reg, collapse="+", sep="")
reg <- paste("~", reg, ifelse(intercept, "", "-1"), sep="")
reg <- as.formula(reg, .GlobalEnv)
h <- rep(list(reg), length(g))
} else {
SUR <- FALSE
if (inherits(h,"formula"))
{
h <- rep(list(h), length(g))
sameMom <- TRUE
} else if (!is.list(h)) {
stop("h must be a list or a formula")
} else if (length(h) == 1) {
h <- rep(h, length(g))
sameMom <- TRUE
} else if (length(h) != length(g)) {
stop("With different instruments, we must have length(h)= length(g)")
} else {
sameMom <- FALSE
}
varh <- lapply(h, .formSpec)
anyEndo <- !sapply(1:length(g),
function(i) all(varg[[i]]$rhs %in% varh[[i]]$rhs) &
(varg[[i]]$intercept==varh[[i]]$intercept))
}
if (!nonlin)
{
model <- .slGmmData(g,h,data, survOptions, vcovOptions, na.action)
isEndo <- lapply(1:length(g),
function(i) model$parNames[[i]] %in% model$momNames[[i]])
gmodel <- new("slinearGmm", data=model$data,
instT=model$instT, modelT=model$modelT,
vcov=vcov, vcovOptions=model$vcovOptions,
centeredVcov = centeredVcov, k=model$k,
q=model$q, n=model$n, parNames=model$parNames,
momNames=model$momNames, eqnNames=model$eqnNames,
sameMom=sameMom, SUR=SUR, varNames=model$varNames,
isEndo=model$isEndo, omit=model$omit,
survOptions=model$survOptions)
} else {
model <- .snlGmmData(g, h, theta0, data, survOptions, vcovOptions, na.action)
gmodel <- new("snonlinearGmm", data=model$data, instT=model$instT,
theta0=theta0,fRHS=model$fRHS,eqnNames=model$eqnNames,
fLHS=model$fLHS, vcov=vcov, vcovOptions=model$vcovOptions,
centeredVcov = centeredVcov, k=model$k, q=model$q,
n=model$n, parNames=model$parNames,
momNames=model$momNames, sameMom=sameMom, SUR=SUR,
varNames=model$varNames, isEndo=model$isEndo, omit=model$omit,
survOptions=model$survOptions)
}
gmodel
}
.formSpec <- function(f, theta=NULL)
{
if (length(f) == 3)
{
rhs <- all.vars(f[[3]])
if (!is.null(theta))
rhs <- rhs[!(rhs%in%names(theta))]
lhs <- all.vars(f[[2]])
if (!is.null(theta))
lhs <- lhs[!(lhs%in%names(theta))]
} else {
lhs <- character()
rhs <- all.vars(f[[2]])
if (!is.null(theta))
rhs <- rhs[!(rhs%in%names(theta))]
}
list(rhs=rhs, lhs=lhs, intercept=attr(terms(f), "intercept"))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.