Mercurial > repos > matthias > dada2_mergepairs

comparison user_input_functions.R @ 0:44230c777694 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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:39:56 -0500
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:44230c777694
1 # defining functions for checking user inputs
2
3 # requesting directory input----------------------------------------------------------
4 dir_input <- function(prompt) {
5 check <- FALSE
6 while(check == FALSE) {
7 user_input <- readline(prompt)
8 check <- dir.exists(user_input)
9 if(check==FALSE) {
10 msg <- sprintf("The directory: %s not found.", user_input)
11 message(msg)
12 }
13 }
14 return(user_input)
15 }
16
17 # requesting file input
18 file_input <- function(prompt, directory) {
19 check <- FALSE
20 while(check == FALSE) {
21 user_input <- readline(prompt)
22 check <- file.exists(file.path(directory, user_input))
23 if(check==FALSE) {
24 msg <- sprintf("File: %s not found.", user_input)
25 message(msg)
26 }
27 }
28 return(user_input)
29 }
30
31 # requesting string input------------------------------------------------------------
32 string_input <- function(prompt) {
33 check <- FALSE
34 while(check == FALSE) {
35 user_input <- readline(prompt)
36 check <- user_input!=''
37 if(check == FALSE) {
38 message("Input can't be empty.")
39 }
40 }
41 return(user_input)
42 }
43
44 # requesting integer input----------------------------------------------------------
45 numeric_input <- function(prompt, default) {
46 check <- FALSE
47 while(check == FALSE) {
48 user_input <- readline(prompt)
49
50 # if blank, set user_input to defalut
51 if(user_input == '') {
52 user_input <- default
53 msg <- sprintf("No input supplied, default of %s used.", default)
54 message(msg)
55 }
56 # coerce input to be numeric
57 else {
58 user_input <- as.numeric(user_input)
59 }
60 # check if number supplied
61 check <- !is.na(user_input)
62 if(check == FALSE) {
63 message("Input must be a number.")
64 }
65 }
66 return(user_input)
67 }
68
69 # request constrained string---------------------------------------------------------
70 # default is numeric, referring to the index of desired option in 'choices'
71 cons_string_input <- function(prompt, choices, default) {
72
73 if(missing(default)){
74 check <- FALSE
75 while(check == FALSE) {
76 user_input <- as.numeric(menu(choices, graphics=FALSE, title=prompt))
77 user_input <- choices[user_input]
78
79 check <- user_input!=''
80 if(check == FALSE) message("Input can't be empty.")
81 else message(sprintf("\nSelected: %s", user_input))
82 }
83 }
84
85 if(!missing(default)){
86 # setting up prompt with menu
87 num_choices <- str_c(1:length(choices), choices, sep='. ')
88 menu_prompt <- sprintf("%s\n\t%s\n", prompt, str_c(num_choices, collapse='\n\t'))
89 message(menu_prompt)
90
91 # requesting user input
92 user_input <- readline("Selection:")
93
94 # setting default
95 if(user_input == '') {
96 user_input <- as.numeric(default)
97 user_input <- choices[user_input]
98 msg <- sprintf("No input supplied, default of %s used.", user_input)
99 message(msg)
100 }
101 else {
102 user_input <- as.numeric(user_input)
103 user_input <- choices[user_input]
104 message(sprintf("\nSelected: %s", user_input))
105 }
106 }
107
108 return(user_input)
109 }
110
111 # request multiple inputs-----------------------------------------------------------
112 ## default is optional; can set default to NULL if want to allow blank entry
113 cons_string_mult <- function(prompt, choices, default) {
114 if(missing(default)) {
115 check <- FALSE
116 while(check == FALSE) {
117 user_input <- select.list(choices=choices, multiple=TRUE, title=prompt,
118 graphics = FALSE)
119
120 if(length(user_input)==0) {
121 message("Input can't be empty.")
122 check <- FALSE
123 }
124 else {
125 message(sprintf("\nSelected: %s", user_input))
126 check <- TRUE
127 }
128 }
129 }
130
131 if(!missing(default)) {
132 user_input <- select.list(choices=choices, multiple=TRUE, title=prompt,
133 graphics=FALSE)
134
135 if(length(user_input)==0) {
136 if(is.null(default)) user_input <- default
137 else user_input <- default
138 msg <- sprintf("No input supplied, using default:%s",
139 paste(user_input, collapse=', '))
140 message(msg)
141 }
142
143 }
144
145 return(user_input)
146
147 }
148
149 # yesno input-------------------------------------------------------------------
150 # default is TRUE or FALSE
151 yn_input <- function(prompt, default) {
152
153 choices <- c("Yes", "No")
154
155 if(missing(default)) {
156 check <- FALSE
157 while(check == FALSE) {
158 user_input <- menu(choices, graphics=FALSE, title=prompt)
159
160 if(length(user_input)==0) {
161 message("Input can't be empty.")
162 check <- FALSE
163 }
164 else {
165 message(sprintf("\nSelected: %s", user_input))
166 check <- TRUE
167 }
168 }
169 user_input <- ifelse(user_input == 1L, TRUE, FALSE)
170 }
171 if(!missing(default)) {
172
173 # setting up prompt with menu
174 num_choices <- str_c(1:length(choices), choices, sep='. ')
175 menu_prompt <- sprintf("%s\n\t%s\n", prompt, str_c(num_choices, collapse='\n\t'))
176 message(menu_prompt)
177
178 # requesting user input
179 user_input <- readline("Selection:")
180
181 # setting default
182 if(user_input == '') {
183 user_input <- as.numeric(default)
184 msg <- sprintf("No input supplied, default of %s used.", choices[user_input])
185 message(msg)
186 user_input <- ifelse(user_input == 1L, TRUE, FALSE)
187 }
188 else {
189 user_input <- as.numeric(user_input)
190 message(sprintf("\nSelected: %s", choices[user_input]))
191 user_input <- ifelse(user_input == 1L, TRUE, FALSE)
192 }
193 }
194
195
196 return(user_input)
197 }