Returns a single fitted model object produced by the underlying fitting algorithm from a tidyfit.models frame based on a given row number.

get_model(df, ..., .first_row = TRUE)

Arguments

df

a tidyfit.models frame created using m(), regress(), classify() and similar methods

...

arguments passed to dplyr::filter to filter row in 'df' for which the model should be returned. filters can also include columns nested in df$settings.

.first_row

should the first row be returned if the (filtered) df contains multiple rows

Value

An object of the class associated with the underlying fitting algorithm

Details

This method is a utility to return the object fitted by the underlying algorithm. For instance, when m("lm") is used to create the tidyfit.models frame, the returned object is of class "lm".

See also

Author

Johann Pfitzinger

Examples

# Load data
data("mtcars")

# fit separate models for transmission types
mtcars <- dplyr::group_by(mtcars, am)

fit <- regress(mtcars, mpg ~ ., m("lm"))

# get the model for single row
summary(get_model(fit, am == 0))
#> 
#> Call:
#> (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
#> })(formula = mpg ~ ., data = structure(list(mpg = c(21.4, 18.7, 
#> 18.1, 14.3, 24.4, 22.8, 19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 
#> 14.7, 21.5, 15.5, 15.2, 13.3, 19.2), cyl = c(6, 8, 6, 8, 4, 4, 
#> 6, 6, 8, 8, 8, 8, 8, 8, 4, 8, 8, 8, 8), disp = c(258, 360, 225, 
#> 360, 146.7, 140.8, 167.6, 167.6, 275.8, 275.8, 275.8, 472, 460, 
#> 440, 120.1, 318, 304, 350, 400), hp = c(110, 175, 105, 245, 62, 
#> 95, 123, 123, 180, 180, 180, 205, 215, 230, 97, 150, 150, 245, 
#> 175), drat = c(3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3.92, 
#> 3.07, 3.07, 3.07, 2.93, 3, 3.23, 3.7, 2.76, 3.15, 3.73, 3.08), 
#>     wt = c(3.215, 3.44, 3.46, 3.57, 3.19, 3.15, 3.44, 3.44, 4.07, 
#>     3.73, 3.78, 5.25, 5.424, 5.345, 2.465, 3.52, 3.435, 3.84, 
#>     3.845), qsec = c(19.44, 17.02, 20.22, 15.84, 20, 22.9, 18.3, 
#>     18.9, 17.4, 17.6, 18, 17.98, 17.82, 17.42, 20.01, 16.87, 
#>     17.3, 15.41, 17.05), vs = c(1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 
#>     0, 0, 0, 0, 1, 0, 0, 0, 0), gear = c(3, 3, 3, 3, 4, 4, 4, 
#>     4, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3), carb = c(1, 2, 1, 4, 
#>     2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 2, 4, 2)), class = "data.frame", row.names = c(NA, 
#> -19L)), weights = NULL, model = TRUE, x = FALSE, y = FALSE)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -2.0346 -1.0493  0.3835  0.6959  2.2395 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)  
#> (Intercept)  8.64345   21.51122   0.402   0.6972  
#> cyl         -0.53391    1.12741  -0.474   0.6471  
#> disp        -0.02025    0.01744  -1.162   0.2753  
#> hp           0.06223    0.04607   1.351   0.2097  
#> drat         0.59159    3.01195   0.196   0.8486  
#> wt           1.95413    2.23132   0.876   0.4039  
#> qsec        -0.88432    0.75840  -1.166   0.2736  
#> vs           0.73891    2.51186   0.294   0.7753  
#> gear         8.65416    3.89565   2.221   0.0534 .
#> carb        -4.81050    1.90037  -2.531   0.0322 *
#> ---
#> Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#> 
#> Residual standard error: 1.804 on 9 degrees of freedom
#> Multiple R-squared:  0.8893,	Adjusted R-squared:  0.7785 
#> F-statistic: 8.031 on 9 and 9 DF,  p-value: 0.00238
#> 

# get model by row number
summary(get_model(fit, dplyr::row_number() == 2))
#> 
#> Call:
#> (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
#> })(formula = mpg ~ ., data = structure(list(mpg = c(21, 21, 22.8, 
#> 32.4, 30.4, 33.9, 27.3, 26, 30.4, 15.8, 19.7, 15, 21.4), cyl = c(6, 
#> 6, 4, 4, 4, 4, 4, 4, 4, 8, 6, 8, 4), disp = c(160, 160, 108, 
#> 78.7, 75.7, 71.1, 79, 120.3, 95.1, 351, 145, 301, 121), hp = c(110, 
#> 110, 93, 66, 52, 65, 66, 91, 113, 264, 175, 335, 109), drat = c(3.9, 
#> 3.9, 3.85, 4.08, 4.93, 4.22, 4.08, 4.43, 3.77, 4.22, 3.62, 3.54, 
#> 4.11), wt = c(2.62, 2.875, 2.32, 2.2, 1.615, 1.835, 1.935, 2.14, 
#> 1.513, 3.17, 2.77, 3.57, 2.78), qsec = c(16.46, 17.02, 18.61, 
#> 19.47, 18.52, 19.9, 18.9, 16.7, 16.9, 14.5, 15.5, 14.6, 18.6), 
#>     vs = c(0, 0, 1, 1, 1, 1, 1, 0, 1, 0, 0, 0, 1), gear = c(4, 
#>     4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 4), carb = c(4, 4, 1, 1, 
#>     2, 1, 1, 2, 2, 4, 6, 8, 2)), class = "data.frame", row.names = c(NA, 
#> -13L)), weights = NULL, model = TRUE, x = FALSE, y = FALSE)
#> 
#> Residuals:
#>        1        2        3        4        5        6        7        8 
#>  1.07088 -0.77411 -0.75528  2.69590  0.03134 -1.23282 -0.63755  0.27164 
#>        9       10       11       12       13 
#>  0.29677 -0.30177 -0.84005  0.57341 -0.39836 
#> 
#> Coefficients:
#>              Estimate Std. Error t value Pr(>|t|)
#> (Intercept) -137.9074    69.1493  -1.994    0.140
#> cyl           -1.2813     4.5374  -0.282    0.796
#> disp           0.1799     0.1756   1.024    0.381
#> hp            -0.1605     0.1434  -1.119    0.345
#> drat          -4.9498     5.4684  -0.905    0.432
#> wt           -10.5419     4.9958  -2.110    0.125
#> qsec           8.0950     3.4515   2.345    0.101
#> vs             0.9431     5.0886   0.185    0.865
#> gear          12.3285     6.6603   1.851    0.161
#> carb           4.6885     4.0645   1.154    0.332
#> 
#> Residual standard error: 2.078 on 3 degrees of freedom
#> Multiple R-squared:  0.9716,	Adjusted R-squared:  0.8864 
#> F-statistic: 11.41 on 9 and 3 DF,  p-value: 0.03498
#>