[Gmm-commits] r204 - in pkg/momentfit: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 19 23:09:42 CEST 2022
Author: chaussep
Date: 2022-10-19 23:09:41 +0200 (Wed, 19 Oct 2022)
New Revision: 204
Modified:
pkg/momentfit/DESCRIPTION
pkg/momentfit/R/momentData.R
pkg/momentfit/R/sysMomentModel-methods.R
Log:
fixed a bug when a regressor name starts with terms
Modified: pkg/momentfit/DESCRIPTION
===================================================================
--- pkg/momentfit/DESCRIPTION 2022-08-12 02:50:41 UTC (rev 203)
+++ pkg/momentfit/DESCRIPTION 2022-10-19 21:09:41 UTC (rev 204)
@@ -1,6 +1,6 @@
Package: momentfit
-Version: 0.3
-Date: 2022-07-30
+Version: 0.4
+Date: 2022-10-19
Title: Methods of Moments
Author: Pierre Chausse <pchausse at uwaterloo.ca>
Maintainer: Pierre Chausse <pchausse at uwaterloo.ca>
Modified: pkg/momentfit/R/momentData.R
===================================================================
--- pkg/momentfit/R/momentData.R 2022-08-12 02:50:41 UTC (rev 203)
+++ pkg/momentfit/R/momentData.R 2022-10-19 21:09:41 UTC (rev 204)
@@ -38,7 +38,7 @@
instF <- model.frame(formula, h, na.action="na.pass",
drop.unused.levels=TRUE)
}
- h <- lapply(1:ncol(Y), function(i) formula(terms(instF), .GlobalEnv))
+ h <- lapply(1:ncol(Y), function(i) formula(attr(instF, "terms"), .GlobalEnv))
data <- cbind(modelF, instF)
data <- data[,!duplicated(colnames(data))]
return(.slModelData(g,h,data,survOptions, vcovOptions,na.action))
@@ -51,7 +51,7 @@
drop.unused.levels=TRUE)
if (is.matrix(modelF[[1]]))
return(.multiToSys(formula, h, data))
- parNames <- colnames(model.matrix(terms(modelF), modelF))
+ parNames <- colnames(model.matrix(attr(modelF, "terms"), modelF))
k <- length(parNames)
if (any(class(h) == "formula"))
{
@@ -76,7 +76,7 @@
instF <- model.frame(formula, h, na.action="na.pass",
drop.unused.levels=TRUE)
}
- momNames <- colnames(model.matrix(terms(instF), instF))
+ momNames <- colnames(model.matrix(attr(instF, "terms"), instF))
q <- length(momNames)
isEndo <- !(parNames %in% momNames)
tmpDat <- cbind(modelF, instF)
@@ -211,7 +211,7 @@
instF <- model.frame(formula, h, na.action="na.pass",
drop.unused.levels=TRUE)
}
- momNames <- colnames(model.matrix(terms(instF), instF))
+ momNames <- colnames(model.matrix(attr(instF, "terms"), instF))
isEndo <- !(varNames %in% momNames)
q <- length(momNames)
tmpDat <- cbind(modelF, instF)
@@ -298,8 +298,8 @@
{
res <- lapply(1:length(g), function(i) .lModelData(g[[i]], h[[i]], data,
list(), list(), "na.pass"))
- modelT <- lapply(res, function(x) terms(x$modelF))
- instT <- lapply(res, function(x) terms(x$instF))
+ modelT <- lapply(res, function(x) attr(x$modelF, "terms"))
+ instT <- lapply(res, function(x) attr(x$instF, "terms"))
allDat <- do.call(cbind, lapply(res, function(x) cbind(x$modelF, x$instF)))
allDat <- allDat[,!duplicated(colnames(allDat))]
add <- survOptions$weights
@@ -350,7 +350,7 @@
list(), "na.pass"))
fRHS <- lapply(res, function(x) x$fRHS)
fLHS <- lapply(res, function(x) x$fLHS)
- instT <- lapply(res, function(x) terms(x$instF))
+ instT <- lapply(res, function(x) attr(x$instF, "terms"))
allDat <- do.call(cbind, lapply(res, function(x) cbind(x$modelF, x$instF)))
allDat <- allDat[,!duplicated(colnames(allDat))]
add <- survOptions$weights
Modified: pkg/momentfit/R/sysMomentModel-methods.R
===================================================================
--- pkg/momentfit/R/sysMomentModel-methods.R 2022-08-12 02:50:41 UTC (rev 203)
+++ pkg/momentfit/R/sysMomentModel-methods.R 2022-10-19 21:09:41 UTC (rev 204)
@@ -156,7 +156,7 @@
}
attr(f, ".Environment")<- .GlobalEnv
x at q[s] <- length(momNames)
- x at instT[[s]] <- terms(f)
+ x at instT[[s]] <- attr(f, "terms")
x at momNames[[s]] <- momNames
}
}
@@ -311,8 +311,8 @@
momNames <- lapply(all, function(s) modelDims(s)$momNames)
varNames <- lapply(all, function(s) s at varNames)
isEndo <- lapply(all, function(s) s at isEndo)
- instT <- lapply(all, function(s) terms(s at instF))
- modelT <- lapply(all, function(s) terms(s at modelF))
+ instT <- lapply(all, function(s) attr(s at instF, "terms"))
+ modelT <- lapply(all, function(s) attr(s at modelF, "terms"))
dat <- do.call(cbind, lapply(all, function(s) cbind(s at modelF, s at instF)))
dat <- dat[,!duplicated(colnames(dat))]
eqnNames <- paste("Eqn", 1:length(all), sep="")
@@ -341,7 +341,7 @@
momNames <- lapply(all, function(s) modelDims(s)$momNames)
varNames <- lapply(all, function(s) s at varNames)
isEndo <- lapply(all, function(s) s at isEndo)
- instT <- lapply(all, function(s) terms(s at instF))
+ instT <- lapply(all, function(s) attr(s at instF, "terms"))
theta0 <- lapply(all, function(s) s at theta0)
eqnNames <- paste("Eqn", 1:length(all), sep="")
dat <- do.call(cbind, lapply(all, function(s) cbind(s at modelF, s at instF)))
@@ -374,7 +374,7 @@
momNames <- c(spec$momNames, lapply(all, function(s) modelDims(s)$momNames))
varNames <- c(x at varNames, lapply(all, function(s) s at varNames))
isEndo <- c(x at isEndo, lapply(all, function(s) s at isEndo))
- instT <- c(x at instT, lapply(all, function(s) terms(s at instF)))
+ instT <- c(x at instT, lapply(all, function(s) attr(s at instF, "terms")))
theta0 <- c(spec$theta0, lapply(all, function(s) modelDims(s)$theta0))
eqNames <- x at eqnNames
eqnNames <- c(eqNames, paste("Eqn",
@@ -406,8 +406,8 @@
momNames <- c(spec$momNames, lapply(all, function(s) modelDims(s)$momNames))
varNames <- c(x at varNames, lapply(all, function(s) s at varNames))
isEndo <- c(x at isEndo, lapply(all, function(s) s at isEndo))
- instT <- c(x at instT, lapply(all, function(s) terms(s at instF)))
- modelT <- c(x at modelT, lapply(all, function(s) terms(s at modelF)))
+ instT <- c(x at instT, lapply(all, function(s) attr(s at instF, "terms")))
+ modelT <- c(x at modelT, lapply(all, function(s) attr(s at modelF, "terms")))
dat <- do.call(cbind, lapply(all, function(s) cbind(s at modelF, s at instF)))
dat <- dat[,!duplicated(colnames(dat))]
eqNames <- x at eqnNames
More information about the Gmm-commits
mailing list