Small bugfixes

More tests Updated README
ncn-foreigners · Jul 15, 2024 · b57f497 · b57f497
1 parent 56d59c7
commit b57f497
Show file tree

Hide file tree

Showing 8 changed files with 2,129 additions and 172 deletions.
diff --git a/R/Internals.R b/R/Internals.R
@@ -499,9 +499,19 @@ singleRinternalGetXvlmMatrix <- function(X, formulas, parNames, contrasts = NULL
   for (k in 1:nPar) {
     # TODO:: Add contrasts here
     if (length(attr(terms(formulas[[k]], data = X), "term.labels")) != 0) {
-      Xses[[k]] <- model.matrix(
-        terms(formulas[[k]], data = X),
-        data = X
+      Xses[[k]] <- tryCatch(
+        expr = {model.matrix(
+          terms(formulas[[k]], data = X),
+          data = X
+        )},
+        error = function (e) {
+          ff <- formulas[[k]]
+          ff[[2]] <- NULL
+          model.matrix(
+            terms(ff, data = X),
+            data = X
+          )
+        }
       )
     } else {
       Xses[[k]] <- model.matrix(

diff --git a/R/smallMethods.R b/R/smallMethods.R
@@ -84,7 +84,9 @@ model.frame.singleRStaticCountData <- function(formula, ...) {
 #' @method model.matrix singleRStaticCountData
 #' @importFrom stats model.matrix
 #' @exportS3Method 
-model.matrix.singleRStaticCountData <- function(object, type = c("lm", "vlm"), ...) {
+model.matrix.singleRStaticCountData <- function(object, 
+                                                type = c("lm", "vlm"), 
+                                                ...) {
   if (missing(type)) type <- "lm"
 
   switch (type,

diff --git a/R/ztHurdlenegbin.R b/R/ztHurdlenegbin.R
@@ -69,18 +69,16 @@ ztHurdlenegbin <- function(nSim = 1000, epsSim = 1e-8, eimStep = 6,
             (1 - PI) * ((alpha * lambda + 1) ^ (2 / alpha) * (alpha ^ 2 * lambda ^ 2 + 2 * alpha * lambda + 1) +
             (alpha * lambda + 1) ^ (1 / alpha) * ((-alpha ^ 2 - 2 * alpha - 1) * lambda ^ 2 - 2 * alpha * lambda - 2) + 1) /
             ((alpha * lambda + 1) ^ (1 / alpha + 1) + (-alpha - 1) * lambda - 1) ^ 2,
-            (1 - PI) *lambda ^ 2 * ((lambda * alpha + 1) ^ (1 / alpha) * 
+            (1 - PI) * lambda ^ 2 * ((lambda * alpha + 1) ^ (1 / alpha) * 
             (lambda * alpha ^ 2 + (lambda + 1) * alpha + 1) * log(lambda * alpha + 1) +
             (lambda * alpha + 1) ^ (1 / alpha) * ((1 - 2 * lambda) * alpha ^ 2 - lambda * alpha) - alpha ^ 2) /
-            (alpha ^ 2 * ((lambda * alpha + 1) ^ (1 / alpha + 1) - lambda * alpha - lambda - 1) ^ 2)
-            (-PI * lambda + lambda + PI) * exp(-lambda) + (1 - PI) * (1 - exp(-lambda)),
-            (1 - lambda) * (1 - exp(-lambda)),
+            (alpha ^ 2 * ((lambda * alpha + 1) ^ (1 / alpha + 1) - lambda * alpha - lambda - 1) ^ 2),
             1 - (lambda - lambda * ((1 + alpha * lambda) ^ (-1 - 1 / alpha))) / 
             (1 - (1 + alpha * lambda) ^ (-1 / alpha) - 
             lambda * ((1 + alpha * lambda) ^ (-1 - 1 / alpha)))
           ) * c(
             lambdaLink(eta[, 1], inverse = TRUE, deriv = 1),
-              alphaLink(eta[,2], inverse = TRUE, deriv = 1),
+             alphaLink(eta[, 2], inverse = TRUE, deriv = 1),
                 piLink(eta[, 3], inverse = TRUE, deriv = 1)
           ), ncol = 3)
         }

diff --git a/R/ztnegbin.R b/R/ztnegbin.R
@@ -53,7 +53,7 @@ ztnegbin <- function(nSim = 1000, epsSim = 1e-8, eimStep = 6,
               (alpha ^ 2 * ((lambda * alpha + 1) ^ (1 / alpha) - 1) ^ 2)
             ) * c(
               lambdaLink(eta[, 1], inverse = TRUE, deriv = 1),
-              alphaLink(eta[, 2], inverse = TRUE, deriv = 1)
+               alphaLink(eta[, 2], inverse = TRUE, deriv = 1)
             ), ncol = 2)
           }
       )

diff --git a/README.Rmd b/README.Rmd
@@ -256,4 +256,4 @@ cat(" First model: AIC = ", AIC(modelInflated), " BIC = ", BIC(modelInflated),
 
 ## Funding
 
-Work on this package is supported by the the National Science Center, OPUS 22 grant no. 2020/39/B/HS4/00941.   
+Work on this package is supported by the the National Science Center, OPUS 20 grant no. 2020/39/B/HS4/00941.   
diff --git a/README.md b/README.md
@@ -459,4 +459,4 @@ and information criteria support the second model:
 ## Funding
 
 Work on this package is supported by the the National Science Center,
-OPUS 22 grant no. 2020/39/B/HS4/00941.
+OPUS 20 grant no. 2020/39/B/HS4/00941.
Original file line number	Diff line number	Diff line change
Expand Up		@@ -256,4 +256,4 @@ cat(" First model: AIC = ", AIC(modelInflated), " BIC = ", BIC(modelInflated),

		## Funding

		Work on this package is supported by the the National Science Center, OPUS 22 grant no. 2020/39/B/HS4/00941.
		Work on this package is supported by the the National Science Center, OPUS 20 grant no. 2020/39/B/HS4/00941.