R/guidelines.R

In dynverse/dynguidelines: User guidelines for trajectory inference

#' Provide guidelines on which methods to use, optionally based on a given dataset
#'
#' `guidelines()` immediately returns a set of guidelines. Use the `answers` arguments to provide answers
#' `guidelines_shiny()` opens the shiny app
#'
#' @param dataset The dynwrap dataset object from which some of the answers will be precomputed
#' @param answers A set answers generated by [answer_questions()]
#'
#' @return Returns a dynguidelines::guidelines object, containing
#'   - `methods`: Ordered tibble containing information about the selected methods
#'   - `method_columns`: Information about what columns in methods are given and whether the were used for filtering or ordering
#'   - `methods_aggr`: Same columns as `methods`, but includes filtered methods
#'   - `answers`: An answers tibble, can be provided again to this function to reproduce the guidelines
#'   - `methods_selected`: Ids for all selected methods, can be given to [dynwrap::infer_trajectory()]
#'
#' @export
guidelines <- function(
  dataset = NULL,
  answers = answer_questions(dataset = dataset)
) {
  # build data with default order and columns
  method_columns <- get_renderers() %>%
    filter(!is.na(default)) %>%
    select(column_id) %>%
    mutate(filter = FALSE, order = ifelse(column_id == "overall_benchmark", TRUE, FALSE))

  # construct data object
  data <- lst(methods_aggr = methods_aggr %>% mutate(selected = FALSE), method_columns, answers)

  # get the answers in a list
  question_answers <- answers %>% select(question_id, answer) %>% deframe()

  # process default
  data <- default_modifier(data, question_answers)

  # call the modifiers if the question is active
  for (question in get_questions()) {
    # only modify if question is checkbox/picker (and therefore NULL can be a valid answer) or if answers is not NULL
    if(question$type %in% c("checkbox", "picker") || !is.null(question_answers[[question$question_id]])) {
      # only modify if question is active
      if(question$active_if(question_answers)) {
        data <- question$modifier(data, question_answers)
        data$methods_aggr %>% select(method_name)
      }
    }
  }

  # filter method_columns based on last
  data$method_columns <- data$method_columns %>%
    group_by(column_id) %>%
    slice(n()) %>%
    ungroup()

  # create the methods
  data$methods <- data$methods_aggr[match(data$methods_selected, data$methods_aggr$method_id), data$method_columns$column_id]

  data <- add_class(data, "dynguidelines::guidelines")
  data
}