R/user_select_from_list.R

In tsouchlarakis/rdoni:

user_select_from_list <- function(
  lst,
  indent = 0,
  msg = NULL,
  allow_range = TRUE,
  return_index = FALSE
) {
  # Prompt user to make a selection from a list. Supports comma- and hyphen-separated selection.
  # For example, a user may select elements from a list as:
  # 1-3, 5, 10-15, 29  ->  [1,2,3,5,10,11,12,13,14,15,29]
  # 
  # Arguments:
  #   lst {char} -- list of selections
  #
  # Keyword Arguments:
  #   indent {int} -- indentation level of all items of `lst` (default: 0)
  #   msg {char} -- [optional] custom message to print instead of default (default: NULL)
  #   allow_range {logical} -- if TRUE, allow user to make multiple selections (default: TRUE)
  #   return_index {logical} -- if TRUE, return the index of `lst` rather than the element itself
  # 
  # Function Dependencies:
  #   - stringr
  #
  # Returns:
  #   {char} -- slice or element of `lst`
  
  library(stringr)
  
  stopifnot(is.character(lst))
  stopifnot(is.numeric(indent))
  stopifnot(is.character(msg) || is.null(msg))
  stopifnot(is.logical(allow_range))
  
  # Print list to console
  tab = paste0(rep("\t", indent), collapse = "")
  echo(paste0(sprintf("%s(%s) %s", tab, seq_along(lst), lst), collapse = "\n"))
  
  # Define `msg` based on whether it is defined as a keyword argument or now
  if (allow_range) {
    if (is.null(msg)) msg = "Please make a selection (hyphen-separated range ok): "  
  } else {
    if (is.null(msg)) msg = "Please make a single selection: "
  }
  
  # Ensure that `msg` does ends in a colon (avoid printing two colons)
  if (substr(trimws(msg), nchar(msg)-1, nchar(msg)) != ":") {
    msg = paste0(msg, ":")
  }
  
  # User must make a valid selection
  # If selection is invalid, re-run through this while loop.
  invalid = TRUE
  while (invalid) {
    # Get user input
    uin_raw = rdoni::input(msg)
    
    # Test if user input is valid. User input must consist only of numbers, commas and/or hyphens
    if (is.na(suppressWarnings(uin_raw %>% str_replace_all("-|,| ", "") %>% trimws() %>% as.numeric()))) {
      echo("User input must consist only of numbers, commas and/or hyphens", error = TRUE)
      invalid = TRUE
      next
    }
    
    # User input is range (valid)
    if (allow_range) {
      uin = strsplit(uin_raw, ",")[[1]]
      selection = c()
      for (x in uin) {
        x = trimws(x)
        if (grepl("-", x)) {
          selection = selection %>% append(
            strsplit(x, "-")[[1]][1] : strsplit(x, "-")[[1]][2]
          )
        } else {
          selection = selection %>% append(as.numeric(x))
        }
      }
      selection = unique(selection)
      
      # Test if range is truly within the length of `lst`
      if (selection[length(selection)] > length(lst) || selection[1] < 1) {
        # Range is outside true length of `lst`
        echo("Entry must be between %s and %s", 1, length(lst), error = TRUE)
        invalid = TRUE
        next
        
      } else {
        # Range is valid, slice list at selection
        if (return_index) {
          val = selection
        } else {
          val = lst[selection]
        }
        break
      }
      
    } else if (grepl("^(\\d+)$", uin_raw)) {
      # User input is a single selection (valid)
      uin = as.numeric(uin_raw)
      if (uin < 1 || uin > length(lst)) {
        echo("Entry must be between %s and %s", 1, length(lst), error = TRUE)
        invalid = TRUE
        next
      }
      if (return_index) {
        val = uin
      } else {
        val = lst[uin]
      }
      break
      
    } else {
      # User input is invalid (not a single selection or a range selection)
      echo("Invalid entry. Must match either '\\d+' or '\\d+-\\d+'", error = TRUE)
      invalid = TRUE
      next
    }
    
  }  # end: while
  
  return(val)
}