Deploying to gh-pages from @ agdamsbo/FreesearchR@54dd332cd8 🚀

reference/getfun.md

@@ -0,0 +1,100 @@
+# Wrapper function to get function from character vector referring to function from namespace. Passed to 'do.call()'
+
+This function follows the idea from this comment:
+https://stackoverflow.com/questions/38983179/do-call-a-function-in-r-without-loading-the-package
+
+## Usage
+
+``` r
+getfun(x)
+```
+
+## Arguments
+
+- x:
+
+  function or function name
+
+## Value
+
+function or character vector
+
+## Examples
+
+``` r
+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: 0x55c5d988db50>
+#> <environment: namespace:stats>
+```