R/show_top_combos.R

In ttrodrigz/onezero: Analysis tools for binary (0/1) data

#' Show Top TURF Combinations
#'
#' This function takes the output of `turf()` and filters the results to just
#' the top `n` combinations according to the `metric` provided. Finally, the
#' results are unnested into a single data frame.
#'
#' @param x A `turf` object.
#' @param n Number of combinations to show, default is `5`.
#' @param metric Metric to sort on, one of `"reach"` (default), `"freq"`. If
#' item weights were used then the options of `"weight"` and `"value"` are also
#' available.
#'
#' @return A `tibble`.
#'
#' @importFrom rlang abort arg_match sym !!
#' @importFrom dplyr %>% select matches slice_max
#' @importFrom purrr pluck map
#' @importFrom tidyr unnest
#' @importFrom collapse roworderv
#'
#' @examples
#' x <- turf(
#'     FoodSample,
#'     items = 2:4,
#'     k = 1:3,
#'     item_weights = c(Bisque = 7.49, Chicken = 10.99, Tofu = 11.99)
#' )
#'
#' show_top_combos(x, n = 2, metric = "reach")
#' show_top_combos(x, n = 2, metric = "freq")
#' show_top_combos(x, n = 2, metric = "weight")
#' show_top_combos(x, n = 2, metric = "value")
#'
#' @export
show_top_combos <- function(x, n = 5, metric = "reach") {


    # Checks ------------------------------------------------------------------

    if (!inherits(x, "turf")) {
        abort("Input to `x` must be a object of class `turf`.")
    }

    # Which metrics are available?
    metric.opts <-
        x$turf$results[[1]] %>%
        select(-combo, -matches("^i")) %>%
        names()

    arg_match(
        arg = metric,
        values = metric.opts
    )


    # Do it -------------------------------------------------------------------

    x %>%
        pluck("turf") %>%
        mutate(
            results = map(
                .x = results,
                .f = ~slice_max(
                    .data = .x,
                    order_by = !!sym(metric),
                    n = n,
                    with_ties = TRUE
                )
            ),
            results = map(
                .x = results,
                .f = ~roworderv(
                    X = .x,
                    cols = metric,
                    decreasing = TRUE
                )
            )
        ) %>%
        unnest(results)


}

utils::globalVariables(c(
    "combo", "results"
))