Skip to contents

# Wrapper function to get function from character vector referring to function from namespace. Passed to 'do.call()'

Source: `R/helpers.R`
`getfun.Rd`

This function follows the idea from this comment: https://stackoverflow.com/questions/38983179/do-call-a-function-in-r-without-loading-the-package

## Usage

    getfun(x)

## Arguments

x

  function or function name

## Value

function or character vector

## Examples

    getfun("stats::lm")
    #> function (formula, data, subset, weights, na.action, method = "qr",
    #>     model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE,
    #>     contrasts = NULL, offset, ...)
    #> {
    #>     ret.x <- x
    #>     ret.y <- y
    #>     cl <- match.call()
    #>     mf <- match.call(expand.dots = FALSE)
    #>     m <- match(c("formula", "data", "subset", "weights", "na.action",
    #>         "offset"), names(mf), 0L)
    #>     mf <- mf[c(1L, m)]
    #>     mf$drop.unused.levels <- TRUE
    #>     mf[[1L]] <- quote(stats::model.frame)
    #>     mf <- eval(mf, parent.frame())
    #>     if (method == "model.frame")
    #>         return(mf)
    #>     else if (method != "qr")
    #>         warning(gettextf("method = '%s' is not supported. Using 'qr'",
    #>             method), domain = NA)
    #>     mt <- attr(mf, "terms")
    #>     y <- model.response(mf, "numeric")
    #>     w <- as.vector(model.weights(mf))
    #>     if (!is.null(w) && !is.numeric(w))
    #>         stop("'weights' must be a numeric vector")
    #>     offset <- model.offset(mf)
    #>     mlm <- is.matrix(y)
    #>     ny <- if (mlm)
    #>         nrow(y)
    #>     else length(y)
    #>     if (!is.null(offset)) {
    #>         if (!mlm)
    #>             offset <- as.vector(offset)
    #>         if (NROW(offset) != ny)
    #>             stop(gettextf("number of offsets is %d, should equal %d (number of observations)",
    #>                 NROW(offset), ny), domain = NA)
    #>     }
    #>     if (is.empty.model(mt)) {
    #>         x <- NULL
    #>         z <- list(coefficients = if (mlm) matrix(NA_real_, 0,
    #>             ncol(y)) else numeric(), residuals = y, fitted.values = 0 *
    #>             y, weights = w, rank = 0L, df.residual = if (!is.null(w)) sum(w !=
    #>             0) else ny)
    #>         if (!is.null(offset)) {
    #>             z$fitted.values <- offset
    #>             z$residuals <- y - offset
    #>         }
    #>     }
    #>     else {
    #>         x <- model.matrix(mt, mf, contrasts)
    #>         z <- if (is.null(w))
    #>             lm.fit(x, y, offset = offset, singular.ok = singular.ok,
    #>                 ...)
    #>         else lm.wfit(x, y, w, offset = offset, singular.ok = singular.ok,
    #>             ...)
    #>     }
    #>     class(z) <- c(if (mlm) "mlm", "lm")
    #>     z$na.action <- attr(mf, "na.action")
    #>     z$offset <- offset
    #>     z$contrasts <- attr(x, "contrasts")
    #>     z$xlevels <- .getXlevels(mt, mf)
    #>     z$call <- cl
    #>     z$terms <- mt
    #>     if (model)
    #>         z$model <- mf
    #>     if (ret.x)
    #>         z$x <- x
    #>     if (ret.y)
    #>         z$y <- y
    #>     if (!qr)
    #>         z$qr <- NULL
    #>     z
    #> }
    #> <bytecode: 0x559a75ec77b0>
    #> <environment: namespace:stats>