Added accepted_ans arg to improve answer handling

This commit is contained in:
Waldir Leoncio 2020-05-20 11:34:26 +02:00
parent 3f8121f5a6
commit ce7fdeb003
2 changed files with 19 additions and 4 deletions

View file

@ -3,10 +3,17 @@
#' @param dlgtitle Title of question #' @param dlgtitle Title of question
#' @param btn Vector of alternatives #' @param btn Vector of alternatives
#' @param defbtn Scalar with the name of the default option #' @param defbtn Scalar with the name of the default option
#' @param accepted_ans Vector containing accepted answers
#' @description This function aims to loosely mimic the behavior of the #' @description This function aims to loosely mimic the behavior of the
#' questdlg function on Matlab #' questdlg function on Matlab
#' @export #' @export
questdlg <- function(quest, dlgtitle, btn = c('y', 'n'), defbtn = 'n') { questdlg <- function(
quest,
dlgtitle,
btn = c('y', 'n'),
defbtn = 'n',
accepted_ans = c('y', 'yes', 'n', 'no')
) {
message(dlgtitle) message(dlgtitle)
# ========================================================================== # ==========================================================================
# Replacing the default option with a capitalized version on btn # Replacing the default option with a capitalized version on btn
@ -21,10 +28,10 @@ questdlg <- function(quest, dlgtitle, btn = c('y', 'n'), defbtn = 'n') {
# Processing answer # Processing answer
# ========================================================================== # ==========================================================================
answer <- tolower(answer) answer <- tolower(answer)
if (!(answer %in% tolower(c(btn)))) { if (!(answer %in% tolower(c(btn, accepted_ans)))) {
if (answer != "") { if (answer != "") {
warning( warning(
"'", answer, "' is not a valid altenative. Defaulting to ", "'", answer, "' is not a valid alternative. Defaulting to ",
defbtn defbtn
) )
} }

View file

@ -4,7 +4,13 @@
\alias{questdlg} \alias{questdlg}
\title{Prompt for multiple-choice} \title{Prompt for multiple-choice}
\usage{ \usage{
questdlg(quest, dlgtitle, btn = c("y", "n"), defbtn = "n") questdlg(
quest,
dlgtitle,
btn = c("y", "n"),
defbtn = "n",
accepted_ans = c("y", "yes", "n", "no")
)
} }
\arguments{ \arguments{
\item{quest}{Question} \item{quest}{Question}
@ -14,6 +20,8 @@ questdlg(quest, dlgtitle, btn = c("y", "n"), defbtn = "n")
\item{btn}{Vector of alternatives} \item{btn}{Vector of alternatives}
\item{defbtn}{Scalar with the name of the default option} \item{defbtn}{Scalar with the name of the default option}
\item{accepted_ans}{Vector containing accepted answers}
} }
\description{ \description{
This function aims to loosely mimic the behavior of the This function aims to loosely mimic the behavior of the