From aec3e51927f923927555ce8993ec31e64b1592eb Mon Sep 17 00:00:00 2001
From: maechler <maechler@00db46b3-68df-0310-9c12-caf00c1e9a41>
Date: Thu, 9 Jan 2025 13:59:26 +0000
Subject: [PATCH] binomial()$linkinv(1L) now works

git-svn-id: https://svn.r-project.org/R/trunk@87546 00db46b3-68df-0310-9c12-caf00c1e9a41
---
 doc/NEWS.Rd                    | 3 +++
 src/library/stats/src/family.c | 9 +++++----
 tests/reg-tests-1e.R           | 8 ++++++++
 3 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd
index e8b210dc3d..f3da4a37ac 100644
--- a/doc/NEWS.Rd
+++ b/doc/NEWS.Rd
@@ -534,6 +534,9 @@
       \item \code{arima(.., seasonal = <wrong-vector>)} correctly errors
       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)}.
     }
   }
 }
diff --git a/src/library/stats/src/family.c b/src/library/stats/src/family.c
index 1bf8f6574f..0e0399208d 100644
--- a/src/library/stats/src/family.c
+++ b/src/library/stats/src/family.c
@@ -65,16 +65,17 @@ SEXP logit_link(SEXP mu)
     double *rans = REAL(ans), *rmu=REAL(mu);
 
     for (i = 0; i < n; i++)
-	rans[i] = log(x_d_omx(rmu[i]));
+	rans[i] = log(x_d_omx(rmu[i]));// log( x/(1-x) )
     UNPROTECT(1);
     return ans;
 }
 
 SEXP logit_linkinv(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);
 
@@ -84,7 +85,7 @@ SEXP logit_linkinv(SEXP eta)
 	    ((etai > THRESH) ? INVEPS : exp(etai));
 	rans[i] = x_d_opx(tmp);
     }
-    UNPROTECT(1);
+    UNPROTECT(nprot);
     return ans;
 }
 
diff --git a/tests/reg-tests-1e.R b/tests/reg-tests-1e.R
index a439436517..a850b7f7c7 100644
--- a/tests/reg-tests-1e.R
+++ b/tests/reg-tests-1e.R
@@ -1722,6 +1722,14 @@ stopifnot(exprs = {
 ## gave solve.default() error (as wrong model failed fitting)
 
 
+##  binomial()$linkinv(<int>)
+lnks <- c("logit", "probit", "cloglog", "cauchit", "log")
+binIlink <- function(eta) sapply(lnks, function(lnk) binomial(lnk)$linkinv(eta))
+stopifnot(identical(binIlink(          0:3),
+                    binIlink(as.double(0:3))))
+## integer type was not allowed for logit (only) in R <= 4.4.2
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,