utils.R 4.98 KB
Newer Older
1
#' @include ROBITools2.R
Eric Coissac's avatar
Eric Coissac committed
2
#'
Eric Coissac's avatar
Eric Coissac committed
3
#' @importFrom glue glue
4 5
#' @importFrom rlang abort warn inform
#'
Eric Coissac's avatar
Eric Coissac committed
6
#'
7 8 9 10 11
NULL

#
# https://stackoverflow.com/questions/11885207/get-all-parameters-as-list
#
Eric Coissac's avatar
Eric Coissac committed
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
.allargs <- function(orig_values = FALSE) {
  # get formals for parent function
  parent_formals <- formals(sys.function(sys.parent(n = 1)))

  # Get names of implied arguments
  fnames <- names(parent_formals)

  # Remove '...' from list of parameter names if it exists
  fnames <- fnames[-which(fnames == '...')]

  # Get currently set values for named variables in the parent frame
  args <- evalq(as.list(environment()), envir = parent.frame())

  # Get the list of variables defined in '...'
  args <- c(args[fnames], evalq(list(...), envir = parent.frame()))

  if(orig_values) {
    # get default values
    defargs <- as.list(parent_formals)
    defargs <- defargs[unlist(lapply(defargs, FUN = function(x) class(x) != "name"))]
    args[names(defargs)] <- defargs
    setargs <- evalq(as.list(match.call())[-1], envir = parent.frame())
    args[names(setargs)] <- setargs
  }
  return(args)
}
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90



#' Builds a serie of unique words
#'
#' \code{n} words of size \code{nletters} are built as a combination of the
#' uppercase letters.
#'
#' @param n an integer value indicating the number of words to generate
#'
#' @param nletters an integer value indicating the number of letters for each
#'   words
#' @return a \code{character} vector of length \code{n}
#'
#' @examples
#'    combine_LETTERS(10)
#'    combine_LETTERS(30)
#'    combine_LETTERS(10,3)
#'    combine_LETTERS(30,3)
#'
#' @author Eric Coissac <eric.coissac@metabarcoding.org>
#' @export
combine_LETTERS <- function(n,
                           nletters = floor(log(n) / log(26)) + 1) {
  f <- function(x) {
    if (x == 1)
      return(LETTERS)

    l <- expand.grid(LETTERS,f(x - 1))
    l <- paste0(l[,2],l[,1])

    if (length(l) > n)
      l[1:n]
    else
      l
  }

  f(nletters)[1:n]
}

#' Indicates if ROBITools send messages to the terminal
#'
#' Mainly indicates if messages are sent to the user terminal
#' to indicate computation progression.
#'
#' @return a logical value
#' @export
#'
#' @examples
#'   is_robi_verbose()
#'
is_robi_verbose <- function()
{
91 92 93 94
    isTRUE(getOption("ROBITools2.verbose")) &&
    interactive() &&
    !isTRUE(getOption("rstudio.notebook.executing")) &&
    !isTRUE(getOption("knitr.in.progress"))
95 96 97 98 99 100 101 102
}


#' Generate an error on false assertion.
#'
#' @param predicat a logical value
#' @param message a character used as error message using the
#'   \code{\link[glue]{glue}} formater
103 104 105 106 107 108
#' @param ... supplementary variables used by the error message
#' @param call	logical, indicating if the call should become part of the error
#' @param .envir the environment where glue evaluate expressions
#' @param .abort the methode to call to raise the error. can be
#'               \code{\link[rlang]{abort}}, the default,
#'               \code{\link[rlang]{warm}}, or \code{\link[rlang]{inform}}
109 110 111 112 113 114 115
#' @return the predicat value
#' @export
#'
#' @examples
#'    robiassert(3==3,"The value {a} is different to value {b}",
#'               a=3,b=4)
#'
116
robiassert <- function(predicat,message,..., .envir = parent.frame(), .abort = abort) {
117
  if (!predicat)
118
    .abort(glue(message,...,.envir = .envir))
119 120 121 122 123 124 125 126 127 128 129 130 131

  invisible(predicat)
}

#' @param arg a character string indicating the name of the argument generating
#'   the error
#' @rdname robiassert
#' @export
#'
#' @examples
#'    robiassert_arg(3==3,"titi","The value {a} is different to value {b}",
#'                   a=3,b=4)
#'
132
robiassert_arg <- function(predicat,arg,message,..., .envir = parent.frame(), .abort = abort) {
Eric Coissac's avatar
Eric Coissac committed
133 134
  message = glue("[{arg}] : {message}",.envir = environment())
  robiassert(predicat,message,...,.envir = .envir, .abort = .abort)
135
}
Eric Coissac's avatar
Eric Coissac committed
136

137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
#' Writes a message on the console in verbose mode
#'
#' The message is written to the console if the code
#' is executed in the verbose mode. The verbose mode
#' can be specified by declaring a `verbose` logical
#' value to `TRUE`. If no `verbose` variable is defined,
#' the result of the `ROBITools2::is_robi_verbose`
#' function is used to decide of the verbose status.
#'
#'
#' @param message a string template sent to the `glue::glue` preprocessor.
#' @param ... other values to be concatenated to the end of the message
#' @param .envir the environment passed to the  `glue::glue` preprocessor
#'
#' @md
#' @export
#'
#' @examples
#'    verbose = TRUE
#'    robimessage("Hello world !")
#'    verbose = FALSE
#'    robimessage("Hello world !")
#'    rm(verbose)
#'    v_mode = is_robi_verbose()
#'    v_mode
#'    robimessage("Hello world !")
#'    options(ROBITools2.verbose = FALSE)
#'    robimessage("Hello world !")
#'    options(ROBITools2.verbose = TRUE)
#'    robimessage("Hello world !")
#'    options(ROBITools2.verbose = v_mode)
robimessage <- function(message,..., .envir = parent.frame()) {
  if (!exists("verbose"))
    verbose <- is_robi_verbose()

  if (verbose) {
    message(glue(message,..., .envir = .envir))
  }
}

Eric Coissac's avatar
Eric Coissac committed
177 178 179 180
#' @export
clone <- function(object) {
  UseMethod("clone",object)
}