ratelimitr/0000755000176200001440000000000015073200462012425 5ustar liggesusersratelimitr/tests/0000755000176200001440000000000015072506475013603 5ustar liggesusersratelimitr/tests/testthat/0000755000176200001440000000000015073200462015427 5ustar liggesusersratelimitr/tests/testthat/test-repeated-calls.R0000644000176200001440000000106315073007175021422 0ustar liggesuserscontext("repeated tests") test_that("rates are consistently obeyed", { skip_on_cran() if(require("microbenchmark", quietly = TRUE)) { f <- function() NULL f_lim <- limit_rate(f, rate(n = 10, period = .03)) timer <- function() { start <- microbenchmark::get_nanotime() replicate(11, f_lim()) end <- microbenchmark::get_nanotime() f_lim <- reset(f_lim) (end - start) / 1E9 } res <- replicate(20, timer()) expect_false(any(res <= .03)) } }) ratelimitr/tests/testthat/test-window.R0000644000176200001440000000142715072043072020043 0ustar liggesuserscontext("running window tests") test_that("rate limited function is always in compliance", { if(require("microbenchmark", quietly = TRUE)) { f <- limit_rate(microbenchmark::get_nanotime, rate(n = 5, period = .03)) res <- replicate(100, f()) lagged_res <- c(rep(NA, 6), res[seq_len(94)]) times <- (res - lagged_res) / 1E9 expect_gt(min(times, na.rm = TRUE), .03) } }) test_that("no failures in a long window", { skip_on_cran() iter <- 10000 n <- 5 period <- .03 f <- limit_rate(microbenchmark::get_nanotime, rate(n = n, period = period)) res <- replicate(iter, f()) lagged_res <- c(rep(NA, n + 1), res[seq_len(iter - (n + 1))]) times <- (res - lagged_res) / 1E9 expect_gt(min(times, na.rm = TRUE), .03) }) ratelimitr/tests/testthat/test-network-lag.R0000644000176200001440000000254715073007175020777 0ustar liggesuserscontext("works with web APIs despite network lag") test_that("requests are received no faster than the allowed rate", { skip_on_cran() # a function that contains a variable "lag" to # represent network lag http_request <- function(lag) { Sys.sleep(lag) TRUE } # the rate-limited version rl_http_request <- limit_rate( http_request, rate(n = 1, period = .5)) mock_server <- function(limit = .5) { previous_request <- NULL function() { now <- proc.time()[["elapsed"]] # return FALSE if we broke the rate limit if (!is.null(previous_request) && now - previous_request <= limit) return(FALSE) # otherwise log the time and return TRUE previous_request <<- now return(TRUE) } } mock_http <- function(limit = .5) { server <- mock_server(limit = limit) function(lag) { # we make the request locally # it may lag though result <- rl_http_request(lag) # then the request reaches the server: server() } } probe <- mock_http(limit = .5) # now we have a request with a long lag followed immediately # by a request with no lag responses <- c(probe(1), probe(0)) expect_true(all(responses)) }) ratelimitr/tests/testthat/test-limit-rate.R0000644000176200001440000000162115073007175020604 0ustar liggesuserscontext("main") timer <- function(expr) { round(system.time(expr)[["elapsed"]], 3) } test_that("rate limited function does not exceed limits", { skip_on_cran() f <- function() NULL f_lim <- limit_rate( f, rate(n = 10, period = .05), rate(n = 40, period = .5), precision = 60 ) time11 <- timer(replicate(11, f_lim())) expect_gt(time11, .05) f_lim <- limit_rate( f, rate(n = 10, period = .05), rate(n = 40, period = .5), precision = 60 ) time41 <- timer(replicate(41, f_lim())) expect_gt(time41, .5) }) test_that("rate-limited groups of functions obey rate limits", { f <- function() NULL g <- function() NULL limited <- limit_rate(list(f = f, g = g), rate(n = 2, period = .1)) evaltime <- timer( {limited$f(); limited$g(); limited$f()} ) expect_gt(evaltime, .1) }) ratelimitr/tests/testthat/test-update-rate.R0000644000176200001440000000077415073007175020760 0ustar liggesuserscontext("updating rate limits") timer <- function(expr) { round(system.time(expr)[["elapsed"]], 3) } test_that("can update rate of existing function, and it obeys the new rate", { skip_on_cran() f <- function() NULL f_lim <- limit_rate( f, rate(n = 5, period = .1), precision = 60 ) tm <- timer(replicate(6, f_lim())) expect_gt(tm, .1) UPDATE_RATE(f_lim, rate(n = 3, period = .1)) tm2 <- timer(replicate(4, f_lim())) expect_gt(tm2, .1) }) ratelimitr/tests/testthat/test-reset.R0000644000176200001440000000172415073007175017663 0ustar liggesuserscontext("reset") test_that("reset works properly for single functions", { skip_on_cran() f <- function() NULL f_lim <- limit_rate(f, rate(2, .2)) start_time <- Sys.time() replicate(2, f_lim()) f_lim2 <- reset(f_lim) t2 <- system.time(replicate(2, f_lim2()))[["elapsed"]] expect_lt(t2, .2) }) test_that("reset works properly for lists of functions", { skip_on_cran() # see issue 8 f <- function() "f" g <- function() "g" ratelim <- .1 limited <- limit_rate( list( f = f, g = g ), rate(n = 1, period = ratelim) ) t1 <- system.time({ limited$f(); limited$g() })[["elapsed"]] expect_gt(t1, ratelim) limited2 <- reset(limited) t2 <- system.time({ limited2$f(); limited2$g() })[["elapsed"]] expect_gt(t2, ratelim) t1_a <- system.time({ limited$f(); limited$g() })[["elapsed"]] expect_gt(t1_a, ratelim) }) ratelimitr/tests/testthat/test-function-errors.R0000644000176200001440000000126015073007175021673 0ustar liggesuserscontext("rate limits work when function doesn't return") test_that("rate limits still work in face of errors", { skip_on_cran() call_log <- rep(NA, 100) counter <- 1L f <- function() { call_log[counter] <<- Sys.time() counter <<- counter + 1L if (runif(1) > .25) stop("blalh") TRUE } n <- 4L period <- .2 safe_f <- function() tryCatch(f(), error = function(e) FALSE) f_lim <- limit_rate(safe_f, rate(n = n, period = period)) res <- replicate(100, f_lim()) lagged_log <- c(rep(NA, n + 1), call_log[seq_len(100 - (n + 1))]) times <- call_log - lagged_log expect_gt(min(times, na.rm = TRUE), period) }) ratelimitr/tests/testthat/test-function-integrity.R0000644000176200001440000000211415072043072022367 0ustar liggesuserscontext("function integerity") test_that("new functions inherit formal arguments from originals", { # see also issue 9 f <- function(x, y = TRUE) if (y) x else -x g <- limit_rate(f, rate(10, 1)) expect_equal(formals(f), formals(g)) }) test_that("new functions have same outputs as originals", { f <- limit_rate(mean, rate(100, .1)) rand <- runif(20) expect_identical( f(rand), mean(rand) ) f <- function() stop("stop") g <- limit_rate(f, rate(10, 1)) err_f <- tryCatch(f(), error = function(e) e) err_g <- tryCatch(g(), error = function(e) e) expect_identical( err_f$message, err_g$message ) expect_identical( class(err_f), class(err_g) ) }) test_that("functions can be called in weird ways", { f <- limit_rate(mean, rate(100, .1)) env <- new.env(parent = baseenv()) env$rand <- runif(20) env$f <- f expect_identical( f(env$rand), eval(quote(f(rand)), envir = env) ) expect_identical( f(env$rand), eval(substitute(f(rand), env = env)) ) }) ratelimitr/tests/testthat.R0000644000176200001440000000010015072506475015555 0ustar liggesuserslibrary(testthat) library(ratelimitr) test_check("ratelimitr") ratelimitr/MD50000644000176200001440000000365515073200462012746 0ustar liggesusers12c526bc6dd75c181d3cbdcda4489798 *DESCRIPTION 0dcc72e8b8541d0518394b9f2530d10f *LICENSE 1688e630ef73244ff193f7e597314694 *NAMESPACE 94f946bdd4ea13a14da78b15a8b1519c *NEWS.md 541e46a7571d99f2b5dd3235393ed768 *R/accessors.R bb65ad69b08350b6bdeeee0dd2dfe067 *R/fixed_queue.R 36de8d3f1a0eb01a51ace632954c4965 *R/function-list.R ca74457a411fd677875a01c732da73bc *R/limit-rate.R df1357b6847bd4116c8be4ace94376d1 *R/policy-wait.R 2a1a9ce386790717c096dd3c0263c55c *R/rate-limit-exception.R 40f20093ceb87342186b8db7697cba2d *R/rate.R faf609833ba4f25636a1c136fd71f447 *R/reset.R 1c77f46168d48f44c725a01c74087d65 *R/token-dispenser.R f2b0aa4c4b64609fcc137c9efa49ce45 *R/update-rate.R 94d6cc4e8b8ae9f20985086fbc392fd1 *README.md 90a4c0456c9540395b34fe0a90736339 *build/vignette.rds 345dd796abf102a66cb9b5ce45724ed9 *inst/doc/introduction.R 4a31389e8d86f777d9b914e2afecd46b *inst/doc/introduction.Rmd 1c11050bef9b05375feae69877cfec48 *inst/doc/introduction.html 72244ed691ace8b634584a1a2c54b4a8 *man/UPDATE_RATE.Rd 442fc9cb9e7fdc9402314546155ea786 *man/get_function.Rd e8c1171ceec7e12fe10ecca8b9e0a6e7 *man/get_precision.Rd 1499bcb7b9cf4d985a862b0d9bcae218 *man/get_rates.Rd 3ea8cb77fd69c0e406df5707f15680a1 *man/limit_rate.Rd 9d29321547ea8e966c85aa0a0aa2720e *man/rate.Rd c095b05b358821387067153c5eeb77c6 *man/reset.Rd 5cf68ad7b77cf0069b7b6753c8e085f7 *tests/testthat.R a5d40204395e46395429c52b56401cbe *tests/testthat/test-function-errors.R 4203ff9c339f698d1f2ddaba898b92f3 *tests/testthat/test-function-integrity.R 804912aef1f0d676215940cb413c66c4 *tests/testthat/test-limit-rate.R f9baf5dea1abef61e09d2d5d3aab7608 *tests/testthat/test-network-lag.R d2729ed45a94d0aa7a28d002f407a54a *tests/testthat/test-repeated-calls.R c9d75677639244507141ab256fcb039f *tests/testthat/test-reset.R a055b7162ebc241534eee49875423181 *tests/testthat/test-update-rate.R 37a2a7cc4ebfbeeaef0312f2de33bb96 *tests/testthat/test-window.R 4a31389e8d86f777d9b914e2afecd46b *vignettes/introduction.Rmd ratelimitr/R/0000755000176200001440000000000015072043072012627 5ustar liggesusersratelimitr/R/update-rate.R0000644000176200001440000000241515072043072015167 0ustar liggesusers#' Update the rate limit of an existing rate limited function #' #' \code{UPDATE_RATE} modifies an existing rate-limited function in place, #' changing the rate limits without otherwise altering the function's behavior. #' When a rate limited function has its rate limits updated, the previous rate #' limits and any calls that would have counted against those rate limits are #' immediately forgotten, and only the new rate limits are obeyed going forward. #' #' @param lf A rate-limited function or group of functions #' @param ... One or more rates, created using \code{\link{rate}} #' @param precision The precision with which time intervals can be measured, in hertz #' #' @examples #' f <- function() NULL #' f_lim <- limit_rate(f, rate(n = 1, period = .1)) #' #' # update the rate limits to 2 calls per .1 second #' UPDATE_RATE(f_lim, rate(n = 2, period = .1)) #' #' @export UPDATE_RATE <- function(lf, ..., precision = 60) { gatekeeper_env <- parent.env(environment(lf)) rates <- list(...) check_rates(rates) gatekeepers <- lapply(rates, function(rate) token_dispenser( n = rate[["n"]], period = rate[["period"]], precision = precision) ) assign("gatekeepers", gatekeepers, pos = gatekeeper_env) invisible() } ratelimitr/R/limit-rate.R0000644000176200001440000001031315072043072015017 0ustar liggesusers#' Limit the rate at which a function will execute #' #' @param f A single function to be rate-limited, or a named list of functions #' @param ... One or more rates, created using \code{\link{rate}} #' @param precision The precision with which time intervals can be measured, in hertz #' #' @return If \code{f} is a single function, then a new function with the same #' signature and (eventual) behavior as the original function, but rate limited. #' If \code{f} is a named list of functions, then a new list of functions with the #' same names and signatures, but collectively bound by a shared rate limit. #' #' @examples #' ## limiting a single function #' f <- limit_rate(Sys.time, rate(n = 5, period = .1)) #' res <- replicate(10, f()) #' ## show the elapsed time between each function call: #' round(res[-1] - head(res, -1), 3) #' #' ## for multiple functions, make sure the list is named: #' f <- function() 1 #' g <- function() 2 #' limited <- limit_rate(list(f = f, g = g), rate(n = 1, period = .1)) #' system.time({limited$f(); limited$g()}) #' #' @seealso \code{\link{rate}}, \code{\link{UPDATE_RATE}} #' #' @name limit_rate #' @export limit_rate <- function(f, ..., precision = 60) UseMethod("limit_rate") check_rates <- function(rates) { is_rate <- function(rt) { if (!inherits(rt, "rate_limit")) stop("Invalid rate") return(TRUE) } is_valid_rate <- vapply(rates, is_rate, FUN.VALUE = logical(1)) if (any(!is_valid_rate)) stop("Input error") } #' @rdname limit_rate #' @export limit_rate.list <- function(f, ..., precision = 60) { flist <- do.call(function_list, f) limit_rate.function_list(flist, ..., precision = 60) } #' @rdname limit_rate #' @export limit_rate.function_list <- function(f, ..., precision = 60) { rates <- list(...) check_rates(rates) gatekeepers <- lapply(rates, function(rate) token_dispenser( n = rate[["n"]], period = rate[["period"]], precision = precision) ) build_function <- function(fun) { newfun <- function(...) { exit_fn <- function() { still_good <- vapply(gatekeepers, deposit, FUN.VALUE = logical(1)) if (!all(still_good)) stop("Unexpected error") } on.exit(exit_fn()) args <- as.list(match.call())[-1] args <- lapply( args, eval, envir = parent.frame() ) nf <- c( quote(fun), args ) is_good <- vapply(gatekeepers, request, FUN.VALUE = logical(1), policy = wait) if (all(is_good)) return(eval(as.call(nf))) else stop("Unexpected error") } formals(newfun) <- formals(args(fun)) structure( newfun, func = fun, info = function() lapply(gatekeepers, function(x) x("info")), class = c("rate_limited_function", class(fun)) ) } new_functions <- lapply(f, build_function) structure(new_functions, class = c("limited_function_list", "function_list")) } #' @rdname limit_rate #' @export limit_rate.function <- function(f, ..., precision = 60) { limit_rate(list(f = f), ..., precision = precision)[["f"]] } #' @export print.rate_limited_function <- function(x, ...) { f <- x rates <- get_rates(f) func <- get_function(f) precision <- get_precision(f) catrate <- function(rate) { cat(" ", rate[["n"]], "calls per", rate[["period"]], "seconds\n") } cat("A rate limited function, with rates (within 1/", precision, " seconds):\n", sep = "") lapply(rates, catrate) print(func) invisible(f) } #' @export print.limited_function_list <- function(x, ...) { flist <- x rates <- get_rates(flist) precision <- get_precision(flist) catrate <- function(rate) { cat(" ", rate[["n"]], "calls per", rate[["period"]], "seconds\n") } cat("A rate limited group of functions, with rates (within 1/", precision, " seconds):\n", sep = "") lapply(rates, catrate) lapply(flist, function(f) print(get_function(f))) invisible(x) } ratelimitr/R/function-list.R0000644000176200001440000000100415072043072015543 0ustar liggesusersfunction_list <- function(...) { flist <- list(...) if (!all(vapply(flist, is.function, FUN.VALUE = logical(1)))) stop("Invalid function") function_names <- names(flist) if (length(function_names) != length(flist)) stop("Each function in a list of functions must be named") tryCatch( lapply(function_names, as.name), error = function(e) stop("Arguments to function_list must have valid names") ) structure(flist, class = "function_list") } ratelimitr/R/fixed_queue.R0000644000176200001440000000222315072043072015254 0ustar liggesusersfixed_queue <- function(n) { # not quite a queue, but a data structure that is like a queue but is # always expected to have the same size. # create by fixing a numeric vector and then moving the pointer to define # the "front" (for popping) and "back" (for pushing) of the queue fq <- vector("numeric", length = n) front_ptr <- 1L back_ptr <- 1L push <- function(number) { # push new entries to the back fq[back_ptr] <<- number # and then update the pointer to the new "back" of the queue if (back_ptr >= n) back_ptr <<- 1L else back_ptr <<- back_ptr + 1L } front <- function() fq[[front_ptr]] pop <- function() { # update the front pointer to the new "front" of the queue if (front_ptr >= n) front_ptr <<- 1L else front_ptr <<- front_ptr + 1L } function(op) switch( op, front = function() front(), push = function(num) push(num), pop = function() pop()) } push <- function(fq, num) fq("push")(num) pop <- function(fq) fq("pop")() front <- function(fq) fq("front")() ratelimitr/R/policy-wait.R0000644000176200001440000000025315072043072015213 0ustar liggesuserswait <- function(tokens, exception) { pause(exception$wait_time) request(tokens, policy = wait) } pause <- function(wait_time) { Sys.sleep(wait_time + .02) } ratelimitr/R/rate-limit-exception.R0000644000176200001440000000055315072043072017020 0ustar liggesuserscondition <- function(subclass, message, call = sys.call(-1), ...) { structure( class = c(subclass, "condition"), list(message = message, call = call, ...) ) } rate_limit_exception <- function(wait_time) { condition("rate_limit_exception", message = "", call = NULL, wait_time = wait_time) } ratelimitr/R/accessors.R0000644000176200001440000000202715072043072014740 0ustar liggesusers#' Access the rate limit(s) of a rate limited function #' #' @param f A rate limited function or group of functions #' #' @export get_rates <- function(f) UseMethod("get_rates") #' Access the rate limit precision #' #' @param f A rate limited function or group of functions #' #' @export get_precision <- function(f) UseMethod("get_precision") #' Access the original function from a rate limited function #' #' @param f A rate limited function or group of functions #' #' @export get_function <- function(f) UseMethod("get_function") #' @export get_rates.rate_limited_function <- function(f) { info <- attr(f, "info")() lapply(info, function(x) rate(x$n, x$period)) } #' @export get_precision.rate_limited_function <- function(f) { attr(f, "info")()[[1]]$precision } #' @export get_function.rate_limited_function <- function(f) { attr(f, "func") } #' @export get_rates.limited_function_list <- function(f) { get_rates(f[[1]]) } #' @export get_precision.limited_function_list <- function(f) { get_precision(f[[1]]) } ratelimitr/R/reset.R0000644000176200001440000000241515072043072014076 0ustar liggesusers#' Re-create a rate-limited function #' #' This function does not modify the original rate-limited function, instead #' it returns a new function with the same rate limits (but no memory of prior #' function calls). #' #' @param f A rate-limited function or group of functions #' #' @examples #' f <- function() NULL #' f_lim <- limit_rate(f, rate(n = 1, period = .1)) #' f_lim() ## the next call to f_lim will trigger the rate limit #' #' f_lim2 <- reset(f_lim) ## but f_lim2 has a fresh start #' #' ## f_lim2 behaves as though no calls have been made #' system.time(f_lim2()) #' #' ## while f_lim is still constrained #' system.time(f_lim()) #' #' @name reset #' @export reset <- function(f) UseMethod("reset") #' @export reset.rate_limited_function <- function(f) { func <- get_function(f) rates <- get_rates(f) precision <- get_precision(f) lim <- function(...) { limit_rate(func, ..., precision = precision) } do.call("lim", rates) } #' @export reset.limited_function_list <- function(f) { funcs <- lapply( f, get_function ) names(funcs) <- names(f) rates <- get_rates(f) precision <- get_precision(f) lim <- function(...) { limit_rate(funcs, ..., precision = precision) } do.call("lim", rates) } ratelimitr/R/token-dispenser.R0000644000176200001440000000275215072043072016072 0ustar liggesuserstime_now <- function() proc.time()[["elapsed"]] token_dispenser <- function(n, period, precision = 60) { assert_that(is.count(n)) assert_that(is.number(period)) original_period <- period # times should be in increments of (1 / precision) of seconds # So period (entered in seconds) is converted to period * precision period <- period * precision init_time <- ceiling(time_now() * precision) tokens <- fixed_queue(n) replicate(n, push(tokens, init_time)) request <- function() { now <- floor(time_now() * precision) token <- front(tokens) if (now > token) { pop(tokens) return(TRUE) } # wait time should be converted back to whole seconds time_to_wait <- (token - now) / precision signalCondition(rate_limit_exception(time_to_wait)) } deposit <- function() { push(tokens, ceiling(time_now() * precision) + period) return(TRUE) } dispatch <- function(action) { switch(action, "request" = request, "deposit" = deposit, "info" = list(n = n, period = original_period, precision = precision)) } structure(dispatch, class = "token_dispenser") } request <- function(x, policy = wait) { tryCatch( x("request")(), rate_limit_exception = function(e) policy(x, e), error = function(e) stop(e$message, call. = FALSE) ) } deposit <- function(x) { x("deposit")() } ratelimitr/R/rate.R0000644000176200001440000000106115072043072013703 0ustar liggesusers#' Create a new rate #' #' @param n Number of allowed events within a period #' @param period Length (in seconds) of measurement period #' #' @examples #' ## a function #' f <- function() NULL #' #' ## limit f to 10 calls per second #' limited_f <- limit_rate(f, rate(n = 10, period = 1)) #' #' @seealso \code{\link{limit_rate}} #' #' @import assertthat #' @export rate <- function(n, period) { assert_that(is.number(n)) assert_that(is.number(period)) structure(c( n = n, period = period ), class = c("rate_limit", "numeric")) } ratelimitr/vignettes/0000755000176200001440000000000015073007355014443 5ustar liggesusersratelimitr/vignettes/introduction.Rmd0000644000176200001440000000515015072043072017624 0ustar liggesusers--- title: "Introduction to ratelimitr" author: "Tarak Shah" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true vignette: > %\VignetteIndexEntry{Introduction to ratelimitr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ## The basics Use ratelimitr to limit the rate at which functions are called. A rate-limited function that allows `n` calls per `period` will never have a window of time of length `period` that includes more than `n` calls. ```{r ex1} library(ratelimitr) f <- function() NULL # create a version of f that can only be called 10 times per second f_lim <- limit_rate(f, rate(n = 10, period = 1)) # time without limiting system.time(replicate(11, f())) # time with limiting system.time(replicate(11, f_lim())) ``` ## Multiple rates Published rate limits often have multiple types of limits. Here is an example of limiting a function so that it never evaluates more than 10 times per .1 seconds, but additionally never evaluates more than 50 times per 1 second. ```{r ex2} f_lim <- limit_rate( f, rate(n = 10, period = .1), rate(n = 50, period = 1) ) # 10 calls do not trigger the rate limit system.time( replicate(10, f_lim()) ) # note that reset does not modify its argument, but returns a new # rate-limited function with a fresh timer f_lim <- reset(f_lim) system.time( replicate(11, f_lim()) ) # similarly, 50 calls don't trigger the second rate limit f_lim <- reset(f_lim) system.time( replicate(50, f_lim()) ) # but 51 calls do: f_lim <- reset(f_lim) system.time( replicate(51, f_lim()) ) ``` ## Multiple functions sharing one (or more) rate limit(s) To limit a group of functions together, just pass `limit_rate` a list of functions instead of a single function. Make sure the list is named, the names will be how you access the rate-limited versions of the functions: ```{r multi-fun-ex} f <- function() "f" g <- function() "g" h <- function() "h" # passing a named list to limit_rate limited <- limit_rate( list(f = f, g = g, h = h), rate(n = 3, period = 1) ) # now limited is a list of functions that share a rate limit. examples: limited$f() limited$g() ``` ```{r echo = FALSE} Sys.sleep(1) ``` The new functions are subject to a single rate limit, regardless of which ones are called or in what order they are called. ```{r multi-fun-ex2} # the first three function calls should not trigger a delay system.time( {limited$f(); limited$g(); limited$h()} ) limited <- reset(limited) # but to evaluate a fourth function call, there will be a delay system.time({ limited$f() limited$g() limited$h() limited$f() }) ``` ratelimitr/NAMESPACE0000644000176200001440000000122215072043072013642 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(get_function,rate_limited_function) S3method(get_precision,limited_function_list) S3method(get_precision,rate_limited_function) S3method(get_rates,limited_function_list) S3method(get_rates,rate_limited_function) S3method(limit_rate,"function") S3method(limit_rate,function_list) S3method(limit_rate,list) S3method(print,limited_function_list) S3method(print,rate_limited_function) S3method(reset,limited_function_list) S3method(reset,rate_limited_function) export(UPDATE_RATE) export(get_function) export(get_precision) export(get_rates) export(limit_rate) export(rate) export(reset) import(assertthat) ratelimitr/LICENSE0000644000176200001440000000005015072043072013426 0ustar liggesusersYEAR: 2016 COPYRIGHT HOLDER: Tarak Shah ratelimitr/NEWS.md0000644000176200001440000000207315073007175013533 0ustar liggesusers# ratelimitr 0.4.2 * Add Authors@R field to DESCRIPTION file * Don't run flaky tests on CRAN (see #16) # ratelimitr 0.4.1 * update maintainer email address # ratelimitr 0.4.0 * added the method UPDATE_RATE to modify existing rate-limited functions in place. # ratelimitr 0.3.8 * ratelimitr now measures time from just after prior function executions, rather than just before. This allows rate limits to be obeyed even in the presence of network latency (see #14). Thanks to @stephlocke. * Due to inherent imprecision of `Sys.sleep`, there were rare occasions where rate-limited functions displayed unexpected and wrong behavior (see #12 and #13). In order to fix the problem, rate-limited functions now wait at least .02 seconds longer than necessary. * Use `proc.time` instead of `Sys.time` to measure time (for increased precision). # ratelimitr 0.3.7 * Edit unit tests so that tests relying on microbenchmark ("Suggests") are conditional on microbenchmark's presence # ratelimitr 0.3.6 * Added a `NEWS.md` file to track changes to the package. * First release on CRAN ratelimitr/inst/0000755000176200001440000000000015073007355013410 5ustar liggesusersratelimitr/inst/doc/0000755000176200001440000000000015073007355014155 5ustar liggesusersratelimitr/inst/doc/introduction.Rmd0000644000176200001440000000515015072043072017336 0ustar liggesusers--- title: "Introduction to ratelimitr" author: "Tarak Shah" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true vignette: > %\VignetteIndexEntry{Introduction to ratelimitr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ## The basics Use ratelimitr to limit the rate at which functions are called. A rate-limited function that allows `n` calls per `period` will never have a window of time of length `period` that includes more than `n` calls. ```{r ex1} library(ratelimitr) f <- function() NULL # create a version of f that can only be called 10 times per second f_lim <- limit_rate(f, rate(n = 10, period = 1)) # time without limiting system.time(replicate(11, f())) # time with limiting system.time(replicate(11, f_lim())) ``` ## Multiple rates Published rate limits often have multiple types of limits. Here is an example of limiting a function so that it never evaluates more than 10 times per .1 seconds, but additionally never evaluates more than 50 times per 1 second. ```{r ex2} f_lim <- limit_rate( f, rate(n = 10, period = .1), rate(n = 50, period = 1) ) # 10 calls do not trigger the rate limit system.time( replicate(10, f_lim()) ) # note that reset does not modify its argument, but returns a new # rate-limited function with a fresh timer f_lim <- reset(f_lim) system.time( replicate(11, f_lim()) ) # similarly, 50 calls don't trigger the second rate limit f_lim <- reset(f_lim) system.time( replicate(50, f_lim()) ) # but 51 calls do: f_lim <- reset(f_lim) system.time( replicate(51, f_lim()) ) ``` ## Multiple functions sharing one (or more) rate limit(s) To limit a group of functions together, just pass `limit_rate` a list of functions instead of a single function. Make sure the list is named, the names will be how you access the rate-limited versions of the functions: ```{r multi-fun-ex} f <- function() "f" g <- function() "g" h <- function() "h" # passing a named list to limit_rate limited <- limit_rate( list(f = f, g = g, h = h), rate(n = 3, period = 1) ) # now limited is a list of functions that share a rate limit. examples: limited$f() limited$g() ``` ```{r echo = FALSE} Sys.sleep(1) ``` The new functions are subject to a single rate limit, regardless of which ones are called or in what order they are called. ```{r multi-fun-ex2} # the first three function calls should not trigger a delay system.time( {limited$f(); limited$g(); limited$h()} ) limited <- reset(limited) # but to evaluate a fourth function call, there will be a delay system.time({ limited$f() limited$g() limited$h() limited$f() }) ``` ratelimitr/inst/doc/introduction.R0000644000176200001440000000342415073007355017024 0ustar liggesusers## ----ex1---------------------------------------------------------------------- library(ratelimitr) f <- function() NULL # create a version of f that can only be called 10 times per second f_lim <- limit_rate(f, rate(n = 10, period = 1)) # time without limiting system.time(replicate(11, f())) # time with limiting system.time(replicate(11, f_lim())) ## ----ex2---------------------------------------------------------------------- f_lim <- limit_rate( f, rate(n = 10, period = .1), rate(n = 50, period = 1) ) # 10 calls do not trigger the rate limit system.time( replicate(10, f_lim()) ) # note that reset does not modify its argument, but returns a new # rate-limited function with a fresh timer f_lim <- reset(f_lim) system.time( replicate(11, f_lim()) ) # similarly, 50 calls don't trigger the second rate limit f_lim <- reset(f_lim) system.time( replicate(50, f_lim()) ) # but 51 calls do: f_lim <- reset(f_lim) system.time( replicate(51, f_lim()) ) ## ----multi-fun-ex------------------------------------------------------------- f <- function() "f" g <- function() "g" h <- function() "h" # passing a named list to limit_rate limited <- limit_rate( list(f = f, g = g, h = h), rate(n = 3, period = 1) ) # now limited is a list of functions that share a rate limit. examples: limited$f() limited$g() ## ----echo = FALSE------------------------------------------------------------- Sys.sleep(1) ## ----multi-fun-ex2------------------------------------------------------------ # the first three function calls should not trigger a delay system.time( {limited$f(); limited$g(); limited$h()} ) limited <- reset(limited) # but to evaluate a fourth function call, there will be a delay system.time({ limited$f() limited$g() limited$h() limited$f() }) ratelimitr/inst/doc/introduction.html0000644000176200001440000004530715073007355017575 0ustar liggesusers Introduction to ratelimitr

Introduction to ratelimitr

Tarak Shah

2025-10-12

The basics

Use ratelimitr to limit the rate at which functions are called. A rate-limited function that allows n calls per period will never have a window of time of length period that includes more than n calls.

library(ratelimitr)
f <- function() NULL

# create a version of f that can only be called 10 times per second
f_lim <- limit_rate(f, rate(n = 10, period = 1))

# time without limiting
system.time(replicate(11, f()))
##    user  system elapsed 
##   0.001   0.000   0.001
# time with limiting
system.time(replicate(11, f_lim()))
##    user  system elapsed 
##   0.004   0.000   1.046

Multiple rates

Published rate limits often have multiple types of limits. Here is an example of limiting a function so that it never evaluates more than 10 times per .1 seconds, but additionally never evaluates more than 50 times per 1 second.

f_lim <- limit_rate(
    f, 
    rate(n = 10, period = .1), 
    rate(n = 50, period = 1)
)

# 10 calls do not trigger the rate limit
system.time( replicate(10, f_lim()) )
##    user  system elapsed 
##   0.001   0.000   0.000
# note that reset does not modify its argument, but returns a new
# rate-limited function with a fresh timer
f_lim <- reset(f_lim)
system.time( replicate(11, f_lim()) )
##    user  system elapsed 
##   0.001   0.000   0.164
# similarly, 50 calls don't trigger the second rate limit
f_lim <- reset(f_lim)
system.time( replicate(50, f_lim()) )
##    user  system elapsed 
##   0.009   0.000   0.574
# but 51 calls do:
f_lim <- reset(f_lim)
system.time( replicate(51, f_lim()) )
##    user  system elapsed 
##   0.014   0.001   1.042

Multiple functions sharing one (or more) rate limit(s)

To limit a group of functions together, just pass limit_rate a list of functions instead of a single function. Make sure the list is named, the names will be how you access the rate-limited versions of the functions:

f <- function() "f"
g <- function() "g"
h <- function() "h"

# passing a named list to limit_rate
limited <- limit_rate(
    list(f = f, g = g, h = h), 
    rate(n = 3, period = 1)
)

# now limited is a list of functions that share a rate limit. examples:
limited$f()
## [1] "f"
limited$g()
## [1] "g"

The new functions are subject to a single rate limit, regardless of which ones are called or in what order they are called.

# the first three function calls should not trigger a delay
system.time(
    {limited$f(); limited$g(); limited$h()}
)
##    user  system elapsed 
##   0.001   0.000   0.001
limited <- reset(limited)

# but to evaluate a fourth function call, there will be a delay
system.time({
    limited$f()
    limited$g() 
    limited$h() 
    limited$f()
})
##    user  system elapsed 
##   0.002   0.000   1.068
ratelimitr/README.md0000644000176200001440000001030015073007175013704 0ustar liggesusersratelimitr ================ [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/ratelimitr)](https://cran.r-project.org/package=ratelimitr) [![R-CMD-check](https://github.com/tarakc02/ratelimitr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/tarakc02/ratelimitr/actions/workflows/R-CMD-check.yaml) ## Installation This package is available on CRAN. To install: ``` r install.packages("ratelimitr") ``` ## Introduction Use ratelimitr to limit the rate at which functions are called. A rate-limited function that allows `n` calls per `period` will never have a window of time of length `period` that includes more than `n` calls. ``` r library(ratelimitr) f <- function() NULL # create a version of f that can only be called 10 times per second f_lim <- limit_rate(f, rate(n = 10, period = 1)) # time without limiting system.time(replicate(11, f())) #> user system elapsed #> 0 0 0 # time with limiting system.time(replicate(11, f_lim())) #> user system elapsed #> 0.005 0.000 1.046 ``` ## Multiple rates Published rate limits often have multiple types of limits. Here is an example of limiting a function so that it never evaluates more than 10 times per .1 seconds, but additionally never evaluates more than 50 times per 1 second. ``` r f_lim <- limit_rate( f, rate(n = 10, period = .1), rate(n = 50, period = 1) ) # 10 calls do not trigger the rate limit system.time(replicate(10, f_lim())) #> user system elapsed #> 0.000 0.000 0.001 # sleeping in between tests to re-set the rate limit timer Sys.sleep(1) # 11 function calls do trigger the rate limit system.time(replicate(11, f_lim())); Sys.sleep(1) #> user system elapsed #> 0.001 0.001 0.143 # similarly, 50 calls don't trigger the second rate limit system.time(replicate(50, f_lim())); Sys.sleep(1) #> user system elapsed #> 0.009 0.000 0.574 # but 51 calls do: system.time(replicate(51, f_lim())); Sys.sleep(1) #> user system elapsed #> 0.012 0.001 1.041 ``` ## Multiple functions sharing one (or more) rate limit(s) To limit a group of functions together, just pass `limit_rate` a list of functions instead of a single function. Make sure the list is named, the names will be how you access the rate-limited versions of the functions: ``` r f <- function() 1 g <- function() 2 h <- function() 3 # passing a named list to limit_rate limited <- limit_rate(list(f = f, g = g, h = h), rate(n = 3, period = 1)) # now limited is a list of functions that share a rate limit. examples: limited$f() #> [1] 1 limited$g() #> [1] 2 ``` The new functions are subject to a single rate limit, regardless of which ones are called or in what order they are called. ``` r # the first three function calls should not trigger a delay system.time( {limited$f(); limited$g(); limited$h()} ) #> user system elapsed #> 0 0 0 # sleep in between tests to reset the rate limit timer Sys.sleep(1) # but to evaluate a fourth function call, there will be a delay system.time( {limited$f(); limited$g(); limited$h(); limited$f()} ) #> user system elapsed #> 0.000 0.001 1.043 ``` ## Limitations `limit_rate` is not safe to use in parallel. The precision with which you can measure the length of time that has elapsed between two events is constrained to some degree, dependent on your operating system. In order to guarantee compliance with rate limits, this package truncates the time (specifically taking the ceiling or the floor based on which would give the most conservative estimate of elapsed time), rounding to the fraction specified in the `precision` argument of `token_dispenser` – the default is 60, meaning time measurements are taken up to the 1/60th of a second. While the conservative measurements of elapsed time make it impossible to overrun the rate limit by a tiny fraction of a second (see [Issue 3](https://github.com/tarakc02/ratelimitr/issues/3)), they also will result in waiting times that are slightly longer than necessary (using the default `precision` of 60, waiting times will be .01-.03 seconds longer than necessary). ratelimitr/build/0000755000176200001440000000000015073007355013532 5ustar liggesusersratelimitr/build/vignette.rds0000644000176200001440000000032715073007355016073 0ustar liggesusersmQ 0 nn(y)@൬ *]exɝnV I}zB B<R?0_cJ[lRPM"\pƚtѢv+{hK ,&!Έyή{س{'ȱ0f#?Ő3)e K={hU=4D쬀ot$qratelimitr/man/0000755000176200001440000000000015072043072013201 5ustar liggesusersratelimitr/man/limit_rate.Rd0000644000176200001440000000303315072043072015620 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/limit-rate.R \name{limit_rate} \alias{limit_rate} \alias{limit_rate.list} \alias{limit_rate.function_list} \alias{limit_rate.function} \title{Limit the rate at which a function will execute} \usage{ limit_rate(f, ..., precision = 60) \method{limit_rate}{list}(f, ..., precision = 60) \method{limit_rate}{function_list}(f, ..., precision = 60) \method{limit_rate}{function}(f, ..., precision = 60) } \arguments{ \item{f}{A single function to be rate-limited, or a named list of functions} \item{...}{One or more rates, created using \code{\link{rate}}} \item{precision}{The precision with which time intervals can be measured, in hertz} } \value{ If \code{f} is a single function, then a new function with the same signature and (eventual) behavior as the original function, but rate limited. If \code{f} is a named list of functions, then a new list of functions with the same names and signatures, but collectively bound by a shared rate limit. } \description{ Limit the rate at which a function will execute } \examples{ ## limiting a single function f <- limit_rate(Sys.time, rate(n = 5, period = .1)) res <- replicate(10, f()) ## show the elapsed time between each function call: round(res[-1] - head(res, -1), 3) ## for multiple functions, make sure the list is named: f <- function() 1 g <- function() 2 limited <- limit_rate(list(f = f, g = g), rate(n = 1, period = .1)) system.time({limited$f(); limited$g()}) } \seealso{ \code{\link{rate}}, \code{\link{UPDATE_RATE}} } ratelimitr/man/get_function.Rd0000644000176200001440000000055715072043072016163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors.R \name{get_function} \alias{get_function} \title{Access the original function from a rate limited function} \usage{ get_function(f) } \arguments{ \item{f}{A rate limited function or group of functions} } \description{ Access the original function from a rate limited function } ratelimitr/man/get_precision.Rd0000644000176200001440000000047615072043072016331 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors.R \name{get_precision} \alias{get_precision} \title{Access the rate limit precision} \usage{ get_precision(f) } \arguments{ \item{f}{A rate limited function or group of functions} } \description{ Access the rate limit precision } ratelimitr/man/reset.Rd0000644000176200001440000000137215072043072014615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reset.R \name{reset} \alias{reset} \title{Re-create a rate-limited function} \usage{ reset(f) } \arguments{ \item{f}{A rate-limited function or group of functions} } \description{ This function does not modify the original rate-limited function, instead it returns a new function with the same rate limits (but no memory of prior function calls). } \examples{ f <- function() NULL f_lim <- limit_rate(f, rate(n = 1, period = .1)) f_lim() ## the next call to f_lim will trigger the rate limit f_lim2 <- reset(f_lim) ## but f_lim2 has a fresh start ## f_lim2 behaves as though no calls have been made system.time(f_lim2()) ## while f_lim is still constrained system.time(f_lim()) } ratelimitr/man/rate.Rd0000644000176200001440000000075515072043072014432 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rate.R \name{rate} \alias{rate} \title{Create a new rate} \usage{ rate(n, period) } \arguments{ \item{n}{Number of allowed events within a period} \item{period}{Length (in seconds) of measurement period} } \description{ Create a new rate } \examples{ ## a function f <- function() NULL ## limit f to 10 calls per second limited_f <- limit_rate(f, rate(n = 10, period = 1)) } \seealso{ \code{\link{limit_rate}} } ratelimitr/man/UPDATE_RATE.Rd0000644000176200001440000000202015072043072015257 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/update-rate.R \name{UPDATE_RATE} \alias{UPDATE_RATE} \title{Update the rate limit of an existing rate limited function} \usage{ UPDATE_RATE(lf, ..., precision = 60) } \arguments{ \item{lf}{A rate-limited function or group of functions} \item{...}{One or more rates, created using \code{\link{rate}}} \item{precision}{The precision with which time intervals can be measured, in hertz} } \description{ \code{UPDATE_RATE} modifies an existing rate-limited function in place, changing the rate limits without otherwise altering the function's behavior. When a rate limited function has its rate limits updated, the previous rate limits and any calls that would have counted against those rate limits are immediately forgotten, and only the new rate limits are obeyed going forward. } \examples{ f <- function() NULL f_lim <- limit_rate(f, rate(n = 1, period = .1)) # update the rate limits to 2 calls per .1 second UPDATE_RATE(f_lim, rate(n = 2, period = .1)) } ratelimitr/man/get_rates.Rd0000644000176200001440000000053215072043072015445 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors.R \name{get_rates} \alias{get_rates} \title{Access the rate limit(s) of a rate limited function} \usage{ get_rates(f) } \arguments{ \item{f}{A rate limited function or group of functions} } \description{ Access the rate limit(s) of a rate limited function } ratelimitr/DESCRIPTION0000644000176200001440000000141615073200462014135 0ustar liggesusersPackage: ratelimitr Type: Package Title: Rate Limiting for R Version: 0.4.2 Authors@R: person(given = "Tarak", family = "Shah", role = c("aut", "cre", "cph"), email = "tarak.shah@gmail.com") Description: Allows to limit the rate at which one or more functions can be called. License: MIT + file LICENSE RoxygenNote: 6.1.0 Suggests: testthat, microbenchmark, knitr, rmarkdown, covr Imports: assertthat VignetteBuilder: knitr URL: https://github.com/tarakc02/ratelimitr BugReports: https://github.com/tarakc02/ratelimitr/issues NeedsCompilation: no Packaged: 2025-10-12 20:26:22 UTC; tshah Author: Tarak Shah [aut, cre, cph] Maintainer: Tarak Shah Repository: CRAN Date/Publication: 2025-10-13 13:40:02 UTC