R/input.R

Defines functions input

input <- function(msg = "Enter input: ", type = "char", indicate_type = FALSE) {
  # Get user commandline input, accounting for running R in interactive mode.
  #
  # Keyword Arguments:
  #   msg {char} -- message to print to console (default: {"Enter input: "})
  #   type {char} -- apply filter to user input, one of c("default", "logical", "date") (default: {"char"})
  #   indicate_type {logical} -- if TRUE, print type of anticipated datatype with message
  #
  # Returns:
  #   {logical} if type = "logical"
  #   {char} otherwise
  
  stopifnot(type %in% c("char", "logical", "date", "numeric"))
  
  get_input <- function(msg) {
    # Get user input dependent on if run in interactive mode.
    #
    # Arguments:
    #   msg {char} -- message to print
    #
    # Returns:
    #   {char}
    if (interactive()) {
      uin_raw = readline(msg)
    } else {
      cat(msg)
      uin_raw = readLines("stdin", n = 1)
    }
    return (uin_raw)
  }
  
  add_colon <- function(x) paste0(x, ": ")
  add_clarification <- function(x, clar) paste0(x, " ", clar)
  
  # Add suffix based on `type`
  msg = trimws(gsub(": *$", "", msg))
  if (type == "logical") {
    msg = add_clarification(msg, "(y/n)")
  } else if (type == "date") {
    msg = add_clarification(msg, "(YYYY-MM-DD)")
  }
  if (indicate_type) {
    msg = add_clarification(msg, sprintf("{%s}", type))
  }
  msg = add_colon(msg)
  
  uin_raw = get_input(msg)
  
  if (type == "logical") {
    while (!test(uin_raw, "logical")) {
      uin_raw = get_input('Must enter "y" or "n": ')
    }
    if (tolower(uin_raw) %in% c("y", "yes", "t", "true")) {
      return (TRUE)
    } else {
      return (FALSE)
    }
  } else if (type == "date") {
    while (!test(uin_raw, "date") && uin_raw != "") {
      uin_raw = get_input('Must enter valid date in format "YYYY-MM-DD": ')
    }
  } else if (type == "numeric") {
    while (!test(uin_raw, "numeric")) {
      uin_raw = get_input("Must enter numeric value: ")
    }
    uin_raw = as.numeric(uin_raw)
  }
  
  return(uin_raw)
}
tsouchlarakis/rdoni documentation built on Sept. 16, 2019, 8:53 p.m.