R/utils.R

Defines functions `%<=%` `%>=%` remove_lt_gt

Documented in remove_lt_gt

#' Remove less-than/greater-than symbols and convert to numeric
#'
#' The following characters will be removed from strings: <, >, =, space. If
#' string contains other characters, the original string will be returned.
#'
#' @param x Vector of numbers possibly containing extraneous strings.
#' @return If non-numeric characters were successfully removed, returns a
#'   numeric vector. If some elements of `x` contained other characters, their
#'   original value will be returned and the result will be a character vector.
remove_lt_gt <- function(x) {
  if (!inherits(x, "character")) {
    return(x)
  }
  num_na <- sum(is.na(x))
  idx <- grep("[^<>=\\.-[:space:][:digit:]]+", x, invert = TRUE)
  x[idx] <- gsub("[<>=[:space:]]", "", x[idx])

  if (suppressWarnings(sum(is.na(as.numeric(x)))) > num_na) {
    return(x)
  } else {
    return(as.numeric(x))
  }
}

#' Greater-than-or-equal-to with a little room for floating point precision
#' issues
#'
#' @param x Numeric vector
#' @param y Numeric vector
`%>=%` <- function(x, y) {
  if (length(x) == 0 | length(y) == 0) {
    return(logical(0))
  }
  x > y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y)
}

#' Less-than-or-equal-to with a little room for floating point precision
#' issues
#'
#' @param x Numeric vector
#' @param y Numeric vector
#' @export
`%<=%` <- function(x, y) {
  if (length(x) == 0 | length(y) == 0) {
    return(logical(0))
  }
  x < y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y)
}

Try the clinPK package in your browser

Any scripts or data that you put into this service are public.

clinPK documentation built on May 9, 2022, 9:06 a.m.