R devel - Apr 2005 - predict.glm(..., type="response") dropping names (and a propsed (PR#7792)

Here's a patch that should make predict.glm(..., type="response")
retain the
names.  The change passes make check on our Opteron running SLES9.  One
simple test is:

names(predict(glm(y ~ x, family=binomial,
                  data=data.frame(y=c(1, 0, 1, 0), x=c(1, 1, 0, 0))),
              newdata=data.frame(x=c(0, 0.5, 1)), type="response"))

which gives

[1] "1" "2" "3"

with this patch, and "NULL" with the current R-beta.

I only use glm() once in a blue moon, so others may want to test other
cases.

Best,
Andy


--- R-beta/src/library/stats/R/family.R	2005-03-04 04:40:03.000000000 -0500
+++ R-beta-fix/src/library/stats/R/family.R	2005-04-14
08:30:03.000000000 -0400
@@ -25,9 +25,9 @@
     else if(!is.character(link) && !is.na(lambda <-
as.numeric(link))) {
         linkfun <- function(mu) mu^lambda
         linkinv <- function(eta)
-            pmax(.Machine$double.eps, eta^(1/lambda))
+            pmax(eta^(1/lambda), .Machine$double.eps)
         mu.eta <- function(eta)
-            pmax(.Machine$double.eps, (1/lambda) * eta^(1/lambda - 1))
+            pmax((1/lambda) * eta^(1/lambda - 1), .Machine$double.eps)
         valideta <- function(eta) all(eta>0)
     }
     else
@@ -36,7 +36,7 @@
                    linkfun <- function(mu) log(mu/(1 - mu))
                    linkinv <- function(eta) {
                        thresh <- -log(.Machine$double.eps)
-                       eta <- pmin(thresh, pmax(eta, -thresh))
+                       eta <- pmin(pmax(eta, -thresh), thresh)
                        exp(eta)/(1 + exp(eta))
                    }
                    mu.eta <- function(eta) {
@@ -52,7 +52,7 @@
                    linkfun <- function(mu) qnorm(mu)
                    linkinv <- function(eta) {
                        thresh <- - qnorm(.Machine$double.eps)
-                       eta <- pmin(thresh, pmax(eta, -thresh))
+                       eta <- pmin(pmax(eta, -thresh), thresh)
                        pnorm(eta)
                    }
                    mu.eta <- function(eta)
@@ -63,7 +63,7 @@
          	   linkfun <- function(mu) qcauchy(mu)
          	   linkinv <- function(eta) {
                        thresh <- -qcauchy(.Machine$double.eps)
-                       eta <- pmin(thresh, pmax(eta, -thresh))
+                       eta <- pmin(pmax(eta, -thresh), thresh)
                        pcauchy(eta)
          	   }
          	   mu.eta <- function(eta)
@@ -73,11 +73,11 @@
                "cloglog" = {
                    linkfun <- function(mu) log(-log(1 - mu))
                    linkinv <- function(eta)
-                       pmax(.Machine$double.eps,
-                            pmin(1 - .Machine$double.eps, -
expm1(-exp(eta))))
+                       pmax(pmin(-expm1(-exp(eta)), 1 -
.Machine$double.eps),
+                            .Machine$double.eps)
                    mu.eta <- function(eta) {
                        eta <- pmin(eta, 700)
-                       pmax(.Machine$double.eps, exp(eta) * exp(-exp(eta)))
+                       pmax(exp(eta) * exp(-exp(eta)), .Machine$double.eps)
                    }
                    valideta <- function(eta) TRUE
                },
@@ -90,9 +90,9 @@
                "log" = {
                    linkfun <- function(mu) log(mu)
                    linkinv <- function(eta)
-                       pmax(.Machine$double.eps, exp(eta))
+                       pmax(exp(eta), .Machine$double.eps)
                    mu.eta <- function(eta)
-                       pmax(.Machine$double.eps, exp(eta))
+                       pmax(exp(eta), .Machine$double.eps)
                    valideta <- function(eta) TRUE
                },
                "sqrt" = {