binomial() $mu.eta(1L) works, too

git-svn-id: https://svn.r-project.org/R/trunk@87553 00db46b3-68df-0310-9c12-caf00c1e9a41
r-devel · Jan 10, 2025 · a66024b · a66024b
1 parent c18e5d6
commit a66024b
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 11 deletions.
diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd
@@ -535,8 +535,8 @@
       now, ditto for \code{arima0()}, thanks to \I{Norbert Kuder}'s report
       on the R-devel list.
 
-      \item \code{binomial(<link>)$linkinv(eta)} now also works for
-      \code{"logit"} link when \code{is.integer(eta)}.
+      \item \code{binomial(<link>)$linkinv(eta)} and \code{.. $mu.eta(eta)}
+      now also work for \code{"logit"} link when \code{is.integer(eta)}.
     }
   }
 }

diff --git a/src/library/stats/src/family.c b/src/library/stats/src/family.c
@@ -91,20 +91,18 @@ SEXP logit_linkinv(SEXP eta)
 
 SEXP logit_mu_eta(SEXP eta)
 {
-    int i, n = LENGTH(eta);
-    if (!n || !isReal(eta))
+    int i, n = LENGTH(eta), nprot = 1;
+    if (!n || !isNumeric(eta))
 	error(_("Argument %s must be a nonempty numeric vector"), "eta");
+    if (!isReal(eta)) {eta = PROTECT(coerceVector(eta, REALSXP)); nprot++;}
     SEXP ans = PROTECT(shallow_duplicate(eta));
     double *rans = REAL(ans), *reta = REAL(eta);
 
     for (i = 0; i < n; i++) {
-	double etai = reta[i];
-	double opexp = 1 + exp(etai);
-
-	rans[i] = (etai > THRESH || etai < MTHRESH) ? DBL_EPSILON :
-	    exp(etai)/(opexp * opexp);
+	double etai = reta[i], expE = exp(etai), opexp = 1 + expE;
+	rans[i] = (etai > THRESH || etai < MTHRESH) ? DBL_EPSILON : expE/(opexp * opexp);
     }
-    UNPROTECT(1);
+    UNPROTECT(nprot);
     return ans;
 }
 

diff --git a/tests/reg-tests-1e.R b/tests/reg-tests-1e.R
@@ -1722,11 +1722,14 @@ stopifnot(exprs = {
 ## gave solve.default() error (as wrong model failed fitting)
 
 
-##  binomial()$linkinv(<int>)
+##  binomial()$ linkinv(<int>)  and  binomial()$ mu.eta(<int>)
 lnks <- c("logit", "probit", "cloglog", "cauchit", "log")
 binIlink <- function(eta) sapply(lnks, function(lnk) binomial(lnk)$linkinv(eta))
+binImuEt <- function(eta) sapply(lnks, function(lnk) binomial(lnk)$mu.eta (eta))
 stopifnot(identical(binIlink(          0:3),
                     binIlink(as.double(0:3))))
+stopifnot(identical(binImuEt(          0:3),
+                    binImuEt(as.double(0:3))))
 ## integer type was not allowed for logit (only) in R <= 4.4.2