view user_input_functions.R @ 1:e4ecd5306895 draft

planemo upload for repository https://github.com/bernt-matthias/mb-galaxy-tools/tree/topic/dada2/tools/dada2 commit d63c84012410608b3b5d23e130f0beff475ce1f8-dirty
author matthias
date Fri, 08 Mar 2019 08:31:24 -0500
parents 56d5be6c03b9
children
line wrap: on
line source

# defining functions for checking user inputs

# requesting directory input----------------------------------------------------------
dir_input <- function(prompt) {
  check <- FALSE
  while(check == FALSE) {
    user_input <- readline(prompt)
    check <- dir.exists(user_input)
    if(check==FALSE) {
      msg <- sprintf("The directory: %s not found.", user_input)
      message(msg)
    }
  }
  return(user_input)
}

# requesting file input
file_input <- function(prompt, directory) {
  check <- FALSE
  while(check == FALSE) {
    user_input <- readline(prompt)
    check <- file.exists(file.path(directory, user_input))
    if(check==FALSE) {
      msg <- sprintf("File: %s not found.", user_input)
      message(msg)
    }
  }
  return(user_input)
}

# requesting string input------------------------------------------------------------
string_input <- function(prompt) {
  check <- FALSE
  while(check == FALSE) {
    user_input <- readline(prompt)
    check <- user_input!=''
    if(check == FALSE) {
      message("Input can't be empty.")
    }
  }
  return(user_input)
}

# requesting integer input----------------------------------------------------------
numeric_input <- function(prompt, default) {
  check <- FALSE
  while(check == FALSE) {
    user_input <- readline(prompt)
    
    # if blank, set user_input to defalut
    if(user_input == '') {
      user_input <- default
      msg <- sprintf("No input supplied, default of %s used.", default)
      message(msg)
    }
    # coerce input to be numeric
    else {
      user_input <- as.numeric(user_input) 
    }
    # check if number supplied
    check <- !is.na(user_input)
    if(check == FALSE) {
      message("Input must be a number.")
    }
  }
  return(user_input)
}

# request constrained string---------------------------------------------------------
# default is numeric, referring to the index of desired option in 'choices'
cons_string_input <- function(prompt, choices, default) {
  
  if(missing(default)){
    check <- FALSE
    while(check == FALSE) {
      user_input <- as.numeric(menu(choices, graphics=FALSE, title=prompt))
      user_input <- choices[user_input]
      
      check <- user_input!=''
      if(check == FALSE) message("Input can't be empty.")
      else message(sprintf("\nSelected: %s", user_input))
    }
  }
  
  if(!missing(default)){
    # setting up prompt with menu
    num_choices <- str_c(1:length(choices), choices, sep='. ')
    menu_prompt <- sprintf("%s\n\t%s\n", prompt, str_c(num_choices, collapse='\n\t'))
    message(menu_prompt)
    
    # requesting user input
    user_input <- readline("Selection:")
    
    # setting default
    if(user_input == '') {
      user_input <- as.numeric(default)
      user_input <- choices[user_input]
      msg <- sprintf("No input supplied, default of %s used.", user_input)
      message(msg)
    }
    else {
      user_input <- as.numeric(user_input)
      user_input <- choices[user_input]
      message(sprintf("\nSelected: %s", user_input))
    }
  }
  
  return(user_input)
}

# request multiple inputs-----------------------------------------------------------
## default is optional; can set default to NULL if want to allow blank entry
cons_string_mult <- function(prompt, choices, default) {
  if(missing(default)) {
    check <- FALSE
    while(check == FALSE) {
      user_input <- select.list(choices=choices, multiple=TRUE, title=prompt, 
                                graphics = FALSE)
      
      if(length(user_input)==0)  {
        message("Input can't be empty.")
        check <- FALSE
      }
      else {
        message(sprintf("\nSelected: %s", user_input))
        check <- TRUE
      }
    }
  }
  
  if(!missing(default)) {
    user_input <- select.list(choices=choices, multiple=TRUE, title=prompt, 
                              graphics=FALSE)
    
    if(length(user_input)==0) {
      if(is.null(default)) user_input <- default
      else user_input <- default
      msg <- sprintf("No input supplied, using default:%s", 
                     paste(user_input, collapse=', '))
      message(msg)
    }
    
  }
  
  return(user_input)
  
}

# yesno input-------------------------------------------------------------------
# default is TRUE or FALSE
yn_input <- function(prompt, default) {
  
  choices <- c("Yes", "No")
  
  if(missing(default)) {
    check <- FALSE
    while(check == FALSE) {
      user_input <- menu(choices, graphics=FALSE, title=prompt)
      
      if(length(user_input)==0)  {
        message("Input can't be empty.")
        check <- FALSE
      }
      else {
        message(sprintf("\nSelected: %s", user_input))
        check <- TRUE
      }
    }
    user_input <- ifelse(user_input == 1L, TRUE, FALSE)
  }
  if(!missing(default)) {
    
    # setting up prompt with menu
    num_choices <- str_c(1:length(choices), choices, sep='. ')
    menu_prompt <- sprintf("%s\n\t%s\n", prompt, str_c(num_choices, collapse='\n\t'))
    message(menu_prompt)
    
    # requesting user input
    user_input <- readline("Selection:")
    
    # setting default
    if(user_input == '') {
      user_input <- as.numeric(default)
      msg <- sprintf("No input supplied, default of %s used.", choices[user_input])
      message(msg)
      user_input <- ifelse(user_input == 1L, TRUE, FALSE)
    }
    else {
      user_input <- as.numeric(user_input)
      message(sprintf("\nSelected: %s", choices[user_input]))
      user_input <- ifelse(user_input == 1L, TRUE, FALSE)
    }
  }
  
  
  return(user_input)
}