ratelimitr/ 0000755 0001762 0000144 00000000000 15073200462 012425 5 ustar ligges users ratelimitr/tests/ 0000755 0001762 0000144 00000000000 15072506475 013603 5 ustar ligges users ratelimitr/tests/testthat/ 0000755 0001762 0000144 00000000000 15073200462 015427 5 ustar ligges users ratelimitr/tests/testthat/test-repeated-calls.R 0000644 0001762 0000144 00000001063 15073007175 021422 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000001427 15072043072 020043 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000002547 15073007175 020777 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000001621 15073007175 020604 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000000774 15073007175 020760 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000001724 15073007175 017663 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000001260 15073007175 021673 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000002114 15072043072 022367 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000000100 15072506475 015555 0 ustar ligges users library(testthat) library(ratelimitr) test_check("ratelimitr") ratelimitr/MD5 0000644 0001762 0000144 00000003655 15073200462 012746 0 ustar ligges users 12c526bc6dd75c181d3cbdcda4489798 *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/ 0000755 0001762 0000144 00000000000 15072043072 012627 5 ustar ligges users ratelimitr/R/update-rate.R 0000644 0001762 0000144 00000002415 15072043072 015167 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000010313 15072043072 015017 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000001004 15072043072 015543 0 ustar ligges users function_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.R 0000644 0001762 0000144 00000002223 15072043072 015254 0 ustar ligges users fixed_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.R 0000644 0001762 0000144 00000000253 15072043072 015213 0 ustar ligges users wait <- 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.R 0000644 0001762 0000144 00000000553 15072043072 017020 0 ustar ligges users condition <- 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.R 0000644 0001762 0000144 00000002027 15072043072 014740 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000002415 15072043072 014076 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000002752 15072043072 016072 0 ustar ligges users time_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.R 0000644 0001762 0000144 00000001061 15072043072 013703 0 ustar ligges users #' 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/ 0000755 0001762 0000144 00000000000 15073007355 014443 5 ustar ligges users ratelimitr/vignettes/introduction.Rmd 0000644 0001762 0000144 00000005150 15072043072 017624 0 ustar ligges users --- 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/NAMESPACE 0000644 0001762 0000144 00000001222 15072043072 013642 0 ustar ligges users # 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/LICENSE 0000644 0001762 0000144 00000000050 15072043072 013426 0 ustar ligges users YEAR: 2016 COPYRIGHT HOLDER: Tarak Shah ratelimitr/NEWS.md 0000644 0001762 0000144 00000002073 15073007175 013533 0 ustar ligges users # 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/ 0000755 0001762 0000144 00000000000 15073007355 013410 5 ustar ligges users ratelimitr/inst/doc/ 0000755 0001762 0000144 00000000000 15073007355 014155 5 ustar ligges users ratelimitr/inst/doc/introduction.Rmd 0000644 0001762 0000144 00000005150 15072043072 017336 0 ustar ligges users --- 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.R 0000644 0001762 0000144 00000003424 15073007355 017024 0 ustar ligges users ## ----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.html 0000644 0001762 0000144 00000045307 15073007355 017575 0 ustar ligges users
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
## user system elapsed
## 0.004 0.000 1.046
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
## user system elapsed
## 0.014 0.001 1.042
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"
## [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