trendbreaker
trendbreaker copied to clipboard
Published
20 hours ago •
reconhub
reconhub
model output for unquoted family argument (cosmetic)
Currently if an unquoted argument is given for the family parameter the formula in the resulting model is the entire function call. Borrowing from the glm code we can get a better input. There may be a better but this will work:
library(trendbreaker)
# current implementation
glm_poisson = glm_model(hp ~ 1 + cyl + drat + wt + qsec + am, poisson)
res <- glm_poisson$train(mtcars)
get_model(res)
#>
#> Call: glm(formula = hp ~ 1 + cyl + drat + wt + qsec + am, family = function (link = "log")
#> {
#> linktemp <- substitute(link)
#> if (!is.character(linktemp))
#> linktemp <- deparse(linktemp)
#> okLinks <- c("log", "identity", "sqrt")
#> family <- "poisson"
#> if (linktemp %in% okLinks)
#> stats <- make.link(linktemp)
#> else if (is.character(link)) {
#> stats <- make.link(link)
#> linktemp <- link
#> }
#> else {
#> if (inherits(link, "link-glm")) {
#> stats <- link
#> if (!is.null(stats$name))
#> linktemp <- stats$name
#> }
#> else {
#> stop(gettextf("link \"%s\" not available for %s family; available links are %s",
#> linktemp, family, paste(sQuote(okLinks), collapse = ", ")),
#> domain = NA)
#> }
#> }
#> variance <- function(mu) mu
#> validmu <- function(mu) all(is.finite(mu)) && all(mu > 0)
#> dev.resids <- function(y, mu, wt) {
#> r <- mu * wt
#> p <- which(y > 0)
#> r[p] <- (wt * (y * log(y/mu) - (y - mu)))[p]
#> 2 * r
#> }
#> aic <- function(y, n, mu, wt, dev) -2 * sum(dpois(y, mu,
#> log = TRUE) * wt)
#> initialize <- expression({
#> if (any(y < 0)) stop("negative values not allowed for the 'Poisson' family")
#> n <- rep.int(1, nobs)
#> mustart <- y + 0.1
#> })
#> simfun <- function(object, nsim) {
#> wts <- object$prior.weights
#> if (any(wts != 1))
#> warning("ignoring prior weights")
#> ftd <- fitted(object)
#> rpois(nsim * length(ftd), ftd)
#> }
#> structure(list(family = family, 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, simulate = simfun),
#> class = "family")
#> }, data = data)
#>
#> Coefficients:
#> (Intercept) cyl drat wt qsec am
#> 6.256607 0.085193 -0.009274 0.176041 -0.136688 0.036604
#>
#> Degrees of Freedom: 31 Total (i.e. Null); 26 Residual
#> Null Deviance: 958.3
#> Residual Deviance: 116.5 AIC: 343.6
# add family check / conversion from glm
glm_model <- function(formula, family, ...) {
if (is.character(family))
family <- get(family, mode = "function", envir = parent.frame())
if (is.function(family))
family <- family()
if (is.null(family$family)) {
print(family)
stop("'family' not recognized")
}
structure(
eval(bquote(list(
model_class = "glm",
train = function(data) {
model <- glm(formula = .(formula), family = .(family$family), data = data, ...)
trendbreaker:::model_fit(model, formula)
}
))),
class = c("trendbreaker_glm", "trendbreaker_model")
)
}
# better formula in model output
glm_poisson = glm_model(hp ~ 1 + cyl + drat + wt + qsec + am, family = poisson)
res <- glm_poisson$train(mtcars)
get_model(res)
#>
#> Call: glm(formula = hp ~ 1 + cyl + drat + wt + qsec + am, family = "poisson",
#> data = data)
#>
#> Coefficients:
#> (Intercept) cyl drat wt qsec am
#> 6.256607 0.085193 -0.009274 0.176041 -0.136688 0.036604
#>
#> Degrees of Freedom: 31 Total (i.e. Null); 26 Residual
#> Null Deviance: 958.3
#> Residual Deviance: 116.5 AIC: 343.6
# still works with character input for family
glm_poisson = glm_model(hp ~ 1 + cyl + drat + wt + qsec + am, family = "poisson")
res <- glm_poisson$train(mtcars)
get_model(res)
#>
#> Call: glm(formula = hp ~ 1 + cyl + drat + wt + qsec + am, family = "poisson",
#> data = data)
#>
#> Coefficients:
#> (Intercept) cyl drat wt qsec am
#> 6.256607 0.085193 -0.009274 0.176041 -0.136688 0.036604
#>
#> Degrees of Freedom: 31 Total (i.e. Null); 26 Residual
#> Null Deviance: 958.3
#> Residual Deviance: 116.5 AIC: 343.6
Created on 2020-08-04 by the reprex package (v0.3.0)
actually, probably better to convert to character and let glm do the failing...
library(trendbreaker)
glm_model <- function(formula, family, ...) {
if (!is.character(family)) {
family <- deparse(substitute(family))
}
structure(
eval(bquote(list(
model_class = "glm",
train = function(data) {
model <- glm(formula = .(formula), family = .(family), data = data, ...)
trendbreaker:::model_fit(model, formula)
}
))),
class = c("trendbreaker_glm", "trendbreaker_model")
)
}
# better formula in model output
glm_poisson = glm_model(hp ~ 1 + cyl + drat + wt + qsec + am, family = poisson)
res <- glm_poisson$train(mtcars)
get_model(res)
#>
#> Call: glm(formula = hp ~ 1 + cyl + drat + wt + qsec + am, family = "poisson",
#> data = data)
#>
#> Coefficients:
#> (Intercept) cyl drat wt qsec am
#> 6.256607 0.085193 -0.009274 0.176041 -0.136688 0.036604
#>
#> Degrees of Freedom: 31 Total (i.e. Null); 26 Residual
#> Null Deviance: 958.3
#> Residual Deviance: 116.5 AIC: 343.6
# still works with character input for family
glm_poisson = glm_model(hp ~ 1 + cyl + drat + wt + qsec + am, family = "poisson")
res <- glm_poisson$train(mtcars)
get_model(res)
#>
#> Call: glm(formula = hp ~ 1 + cyl + drat + wt + qsec + am, family = "poisson",
#> data = data)
#>
#> Coefficients:
#> (Intercept) cyl drat wt qsec am
#> 6.256607 0.085193 -0.009274 0.176041 -0.136688 0.036604
#>
#> Degrees of Freedom: 31 Total (i.e. Null); 26 Residual
#> Null Deviance: 958.3
#> Residual Deviance: 116.5 AIC: 343.6
Created on 2020-08-04 by the reprex package (v0.3.0)