utils.R 4.98 KB
Newer Older
Eric Coissac's avatar
Eric Coissac committed
1
#' @include ROBITools2.R
Eric Coissac's avatar
Eric Coissac committed
2
#'
Eric Coissac's avatar
Eric Coissac committed
3
#' @importFrom glue glue
Eric Coissac's avatar
Eric Coissac committed
4 5
#' @importFrom rlang abort warn inform
#'
Eric Coissac's avatar
Eric Coissac committed
6
#'
Eric Coissac's avatar
Eric Coissac committed
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)
}
Eric Coissac's avatar
Eric Coissac committed
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()
{
Eric Coissac's avatar
Eric Coissac committed
91 92 93 94
    isTRUE(getOption("ROBITools2.verbose")) &&
    interactive() &&
    !isTRUE(getOption("rstudio.notebook.executing")) &&
    !isTRUE(getOption("knitr.in.progress"))
Eric Coissac's avatar
Eric Coissac committed
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
Eric Coissac's avatar
Eric Coissac committed
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}}
Eric Coissac's avatar
Eric Coissac committed
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)
#'
Eric Coissac's avatar
Eric Coissac committed
116
robiassert <- function(predicat,message,..., .envir = parent.frame(), .abort = abort) {
Eric Coissac's avatar
Eric Coissac committed
117
  if (!predicat)
Eric Coissac's avatar
Eric Coissac committed
118
    .abort(glue(message,...,.envir = .envir))
Eric Coissac's avatar
Eric Coissac committed
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)
#'
Eric Coissac's avatar
Eric Coissac committed
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)
Eric Coissac's avatar
Eric Coissac committed
135
}
Eric Coissac's avatar
Eric Coissac committed
136

Eric Coissac's avatar
Eric Coissac committed
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)
}