[Rd] predict.glm(...,
type="response") dropping names (and a propsed (PR#7792)
andy_liaw at merck.com
andy_liaw at merck.com
Thu Apr 14 16:17:36 CEST 2005
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" = {
More information about the R-devel
mailing list