search for: linkinv

As of r87537, binomial()$linkinv no longer accepts integer arguments. binomial()$linkinv(1.0) ## 0.7310586 binomial()$linkinv(1L) Error in binomial()$linkinv(1L) : REAL() can only be applied to a 'numeric', not a 'integer' Since R is usually so permissive/sloppy with the distinction between integers and...

...t; I haven't done the archaeology to figure out when this broke/exactly > what change in the R code base broke it: it happened within the last > month or so binomial() itself exhibits this property even in R-4.2.2 from more than two years ago: R -q -s -e 'getRversion(); binomial()$linkinv(1L)' # [1] ?4.2.2? # Error in binomial()$linkinv(1L) : # REAL() can only be applied to a 'numeric', not a 'integer' It's the `etas` [1] that suddenly became integer due to a change in seq.int(): R -q -s -e 'str(seq.int(-8, 8, by=1))' # num [1:17] -8 -7 -6 -5 -4...

...eology to figure out when this broke/exactly >> what change in the R code base broke it: it happened within the last >> month or so > > binomial() itself exhibits this property even in R-4.2.2 from more than > two years ago: > > R -q -s -e 'getRversion(); binomial()$linkinv(1L)' > # [1] ?4.2.2? > # Error in binomial()$linkinv(1L) : > # REAL() can only be applied to a 'numeric', not a 'integer' > > It's the `etas` [1] that suddenly became integer due to a change in > seq.int(): > > R -q -s -e 'str(seq.int(-8, 8, b...

...this broke/exactly >>> what change in the R code base broke it: it happened within the last >>> month or so >> >> binomial() itself exhibits this property even in R-4.2.2 from more than >> two years ago: >> >> R -q -s -e 'getRversion(); binomial()$linkinv(1L)' >> # [1] ?4.2.2? >> # Error in binomial()$linkinv(1L) : >> #?? REAL() can only be applied to a 'numeric', not a 'integer' >> >> It's the `etas` [1] that suddenly became integer due to a change in >> seq.int(): >> >> R -q -...

...difference.criterion) stop (paste("POD.ceiling-POD.floor difference must be greater than ",difference.criterion," to discourage answer-shopping.", sep="")) linkfun <- function(mu) { mu <- qlogis( (mu - POD.floor)/(POD.ceiling - POD.floor) ) } linkinv <- function(eta) { eta <- POD.floor + (POD.ceiling - POD.floor)*plogis(eta) } mu.eta <- function(eta) { (POD.ceiling - POD.floor)*dlogis(eta)# derivitaive of mu with respect to eta } valideta <- function(eta) TRUE link <- paste("logit.FC("...

...;> what change in the R code base broke it: it happened within the last >>>> month or so >>> >>> binomial() itself exhibits this property even in R-4.2.2 from more than >>> two years ago: >>> >>> R -q -s -e 'getRversion(); binomial()$linkinv(1L)' >>> # [1] ?4.2.2? >>> # Error in binomial()$linkinv(1L) : >>> # REAL() can only be applied to a 'numeric', not a 'integer' >>> >>> It's the `etas` [1] that suddenly became integer due to a change in >>> seq.int():...

Dear all I am using NAMESPACE in my package but I would like the user to be able to overwrite four functions: own.linkfun, own.linkinv, own.mu.eta and own.valideta. These are used to defined "own" link functions. Is there any way of doing that without getting the when I am checking the package? This is what I am getting: make.link.gamlss : linkfun: no visible binding for global variable 'own.linkfun' make.l...

...al(cc, parent.frame())) 16 } 17 if (is.null(weights)) 18 weights <- rep(1, nobs) 19 if (is.null(offset)) 20 offset <- rep(0, nobs) 21 variance <- family$variance 22 dev.resids <- family$dev.resids 23 aic <- family$aic 24 linkinv <- family$linkinv 25 mu.eta <- family$mu.eta 26 if (!is.function(variance) || !is.function(linkinv)) 27 stop("illegal `family' argument") 28 valideta <- family$valideta 29 if (is.null(valideta)) 30 valideta <- function(eta) TRU...

Hi, I wish to write a new link function for a GLM. R's glm routine does not supply the "loglog" link. I modified the make.link function adding the code: }, loglog = { linkfun <- function(mu) -log(-log(mu)) linkinv <- function(eta) exp(-exp(-eta)) mu.eta <- function(eta) exp(-exp(-eta)-eta) valideta <- function(eta) all(eta != 0) }, stop(sQuote(link), " link not recognised")) structure(list(linkfun = linkfun, linkinv = linkinv, mu.eta = mu.eta, valideta...

.../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$d...

...L seems to work, but as I want to evaluate a suite of competing models, I'd like to use ML or REML estimation methods in order to end up with meaningful log-likelihoods. Here's the link function I use: logexp <- function(days = 1) { linkfun <- function(mu) qlogis(mu^(1/days)) linkinv <- function(eta) plogis(eta)^days mu.eta <- function(eta) days*.Call("logit_mu_eta", eta, PACKAGE = "stats")*plogis(eta)^(days-1) valideta <- function(eta) TRUE link <- paste("logexp(", days, ")", sep="") str...

...to this problem. I have appended the function i wrote. Add.haz<-function () { env <- new.env(parent = .GlobalEnv) assign(".nziek", nziek, envir = env) famname<-"Addhaza" link="addlink" linkfun<-function(mu) -log(1-mu) linkinv<-function(eta) 1-exp(-eta) variance<-function(mu) mu*(1-mu) validmu<-function(mu) all(mu > 0) && all(mu < 1) mu.eta<-function(mu) 1/(1-mu) dev.resids <- function(y, mu, wt) 2 * wt * (y * log(ifelse(y == 0, 1, y/mu)) + (1 - y) *...

...mu) qlogis(2*mu-1) half.logit.inv=function(eta) .5*plogis(eta)+.5 half.logit.deriv=function(eta) .5*(exp(eta/2)+exp(-eta/2))^-2 half.logit.inv.indicator=function(eta) TRUE half.logit.indicator=function(mu) mu>.5 & mu<1 link <- "half.logit" structure(list(linkfun = half.logit, linkinv = half.logit.inv, ??????????????????? mu.eta = half.logit.deriv, validmu = half.logit.indicator ,valideta = half.logit.inv.indicator, name = link), ?????????????? class = "link-glm") } # submit halflogit function to lmer rcNrPSrcNxPSxP<-lmer(Correct~-1+cNoise*f_Pos+f_Shape_con+f_Shape_...

...my understanding is that lmer does not currently allow a custom link. Therefore, I was investigating if other procedures for mixed models will allow a custom link function. here is the custom link function: logexp <- function(days = 1) { linkfun <- function(mu) qlogis(mu^(1/days)) linkinv <- function(eta) plogis(eta)^days mu.eta <- function(eta) days * plogis(eta)^(days-1) * .Call("logit_mu_eta", eta, PACKAGE = "stats") valideta <- function(eta) TRUE link <- paste("logexp(", days, ")", sep="") struct...

...low to illustrate what I'm hoping to scale up to a mixed model. Thanks very much for your time and thoughts. ----------------- library(MASS) logexp <- function(days = 1) ##Custom link function from Shaffer (2004) Auk 121:526-540. { linkfun <- function(mu) qlogis(mu^(1/days)) linkinv <- function(eta) plogis(eta)^days mu.eta <- function(eta) days * plogis(eta)^(days-1) * .Call("logit_mu_eta", eta, PACKAGE = "stats") valideta <- function(eta) TRUE link <- paste("logexp(", days, ")", sep="") struct...

...variancetemp), domain = NA)) initialize <- expression({ n <- rep.int(1, nobs) mustart <- y + 0.1 * (y == 0) }) aic <- function(y, n, mu, wt, dev) NA structure(list(family = "quasi", link = linktemp, linkfun = stats$linkfun, linkinv = stats$linkinv, variance = variance, dev.resids = dev.resids, aic = aic, mu.eta = stats$mu.eta, initialize = initialize, validmu = validmu, valideta = stats$valideta, varfun = variancetemp), class = "family") }

...d(seed) n <- length(fitted(fit)) theta <- model.matrix(fit$terms, data=fit$data) %*% coef(fit) ymat <- matrix(NA, nrow=n, ncol=nsim) for (s in 1:nsim) { if ("poisson"==fit$family$family) { ymat[,s] <- rpois(n, fit$family$linkinv(theta)) } else if ("binomial"==fit$family$family) { ymat[,s] <- rbinom(n, 1, fit$family$linkinv(theta)) } } as.data.frame(ymat) } # Eg: simulate.glm.hack(fit.poisson)[[1]] # [1] 1 6 4 7 5 9 7 3 3 4 2 4 3 7 4 4 7 2 4 6 simula...

...pred <- predict.lm(object, newdata, se.fit, scale = 1, type = ifelse(type == "link", "response", type), terms = terms, na.action = na.action) switch(type, response = {pred <- family(object)$linkinv(pred)}, link = , terms = ) } } else { ## summary.survreg has no ... argument. if(inherits(object, "survreg")) dispersion <- 1. if(is.null(dispersion) || dispersion == 0) dispersion <- summary(object, dispersion=dispersion)$dispersion...

I would like to do an R glm() with family = binomial(link="loglog") Right now, the cloglog link exists, which is nice when the data have a heavy tail to the left. I have the opposite case and the loglog link is what I need. Can someone suggest how to add the loglog link onto glm()? It would be lovely to have it there by default, and it certainly makes sense to have the two opposite

...else { pred <- predict.lm(object, newdata, se.fit, scale = 1, type = ifelse(type == "link", "response", type), terms = terms, na.action = na.action) switch(type, response = { pred <- family(object)$linkinv(pred) }, link = , terms = ) } } else { if (inherits(object, "survreg")) dispersion <- 1 if (is.null(dispersion) || dispersion == 0) dispersion <- summary(object, dispersion = dispersion)$dispersion residual.scale <- as.vector(sqrt(di...