Nothing
#' metrumrg snap function
#'
#' @param x numeric vector to snap
#' @param rule vector of points to snap to
#' @param left direction to snap to
#' @param ... not used
#'
#' @export
snap <- function (x, rule = 1, left = TRUE, ...)
{
stopifnot(is.numeric(x), is.numeric(rule), is.finite(rule))
if (!length(x))
return(x)
rule <- sort(unique(rule))
if (length(rule) == 1) {
stopifnot(rule > 0)
lo <- min(x, na.rm = TRUE)
hi <- max(x, na.rm = TRUE)
lo <- (lo%/%rule) * rule - rule
hi <- (hi%/%rule) * rule + rule
rule <- seq(from = lo, to = hi, by = rule)
}
lt <- findInterval(x, rule)
rt <- findInterval(x, rule) + 1
lt[lt == 0] <- 1
rt[rt > length(rule)] <- length(rule)
lt <- rule[lt]
rt <- rule[rt]
fun <- match.fun(if (left)
"<="
else "<")
closer <- ifelse(fun(abs(x - lt), abs(rt - x)), lt, rt)
closer
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.