R/utils.r

Defines functions check.is.function check.is.posint check.is.natnum check.is.int check.is.string check.is.scalar check.is.flag is.annoying is.negative is.zero is.inty is.badval title_case

title_case <- function(x) gsub(x, pattern="(^|[[:space:]])([[:alpha:]])", replacement="\\1\\U\\2", perl=TRUE)


is.badval <- function(x)
{
   is.na(x) || is.nan(x) || is.infinite(x)
}

is.inty <- function(x)
{
  abs(x - round(x)) < 1e-10
}

is.zero <- function(x)
{
  abs(x) < 1e-10
}

is.negative <- function(x)
{
  x < 0
}

is.annoying <- function(x)
{
  length(x) != 1 || is.badval(x)
}



check.is.flag <- function(x)
{
  if (!is.logical(x) || is.annoying(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be TRUE or FALSE"), call.=FALSE)
  }
  
  invisible(TRUE)
}



check.is.scalar <- function(x)
{
  if (!is.numeric(x) || is.annoying(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be a single number (not NA, Inf, NaN)"), call.=FALSE)
  }
  
  invisible(TRUE)
}



check.is.string <- function(x)
{
  if (!is.character(x) || is.annoying(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be a single string"), call.=FALSE)
  }
  
  invisible(TRUE)
}



check.is.int <- function(x)
{
  if (!is.numeric(x) || is.annoying(x) || !is.inty(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be an integer"), call.=FALSE)
  }
  
  invisible(TRUE)
}



check.is.natnum <- function(x)
{
  if (!is.numeric(x) || is.annoying(x) || !is.inty(x) || is.negative(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be a natural number (0 or positive integer)"), call.=FALSE)
  }
  
  invisible(TRUE)
}



check.is.posint <- function(x)
{
  if (!is.numeric(x) || is.annoying(x) || !is.inty(x) || is.negative(x) || is.zero(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be a positive integer"), call.=FALSE)
  }
  
  invisible(TRUE)
}



check.is.function <- function(x)
{
  if (!is.function(x))
  {
    nm <- deparse(substitute(x))
    stop(paste0("argument '", nm, "' must be a function"), call.=FALSE)
  }
  
  invisible(TRUE)
}
wrathematics/lineSampler documentation built on May 13, 2018, 11:19 a.m.