Mercurial > repos > matthias > dada2_makesequencetable
diff user_input_functions.R @ 0:98e24c66eeb2 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 06:42:56 -0500 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/user_input_functions.R Fri Mar 08 06:42:56 2019 -0500 @@ -0,0 +1,197 @@ +# 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) +} \ No newline at end of file