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.007 0.000 1.029
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.001
# 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.002 0.000 0.158
# 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.012 0.000 0.560
# but 51 calls do:
f_lim <- reset(f_lim)
system.time( replicate(51, f_lim()) )
## user system elapsed
## 0.013 0.002 1.053
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"
## [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.001 0.000 1.059
ratelimitr/inst/doc/introduction.Rmd 0000644 0001762 0000144 00000005150 13025641534 017341 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/tests/ 0000755 0001762 0000144 00000000000 13005527640 013572 5 ustar ligges users ratelimitr/tests/testthat.R 0000644 0001762 0000144 00000000100 13025622256 015545 0 ustar ligges users library(testthat)
library(ratelimitr)
test_check("ratelimitr")
ratelimitr/tests/testthat/ 0000755 0001762 0000144 00000000000 13356471726 015446 5 ustar ligges users ratelimitr/tests/testthat/test-function-integrity.R 0000644 0001762 0000144 00000002114 13025630277 022374 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/test-update-rate.R 0000644 0001762 0000144 00000000751 13341267235 020754 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", {
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-network-lag.R 0000644 0001762 0000144 00000002524 13341267235 020773 0 ustar ligges users context("works with web APIs despite network lag")
test_that("requests are received no faster than the allowed rate", {
# 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 00000001576 13053070061 020603 0 ustar ligges users context("main")
timer <- function(expr) {
round(system.time(expr)[["elapsed"]], 3)
}
test_that("rate limited function does not exceed limits", {
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-reset.R 0000644 0001762 0000144 00000001656 13053070061 017655 0 ustar ligges users context("reset")
test_that("reset works properly for single functions", {
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", {
# 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 00000001235 13307521077 021675 0 ustar ligges users context("rate limits work when function doesn't return")
test_that("rate limits still work in face of errors", {
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-repeated-calls.R 0000644 0001762 0000144 00000001040 13053070061 021403 0 ustar ligges users context("repeated tests")
test_that("rates are consistently obeyed", {
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 13113433152 020037 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/NAMESPACE 0000644 0001762 0000144 00000001222 13356460076 013654 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/NEWS.md 0000644 0001762 0000144 00000001722 13356455276 013546 0 ustar ligges users # 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/R/ 0000755 0001762 0000144 00000000000 13341267235 012635 5 ustar ligges users ratelimitr/R/reset.R 0000644 0001762 0000144 00000002415 13341267235 014104 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/accessors.R 0000644 0001762 0000144 00000002027 13341267235 014746 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/rate-limit-exception.R 0000644 0001762 0000144 00000000553 13007121754 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/rate.R 0000644 0001762 0000144 00000001061 13025327375 013712 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/R/token-dispenser.R 0000644 0001762 0000144 00000002752 13341267235 016100 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/fixed_queue.R 0000644 0001762 0000144 00000002223 13017202143 015245 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/limit-rate.R 0000644 0001762 0000144 00000010313 13341267235 015025 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/policy-wait.R 0000644 0001762 0000144 00000000253 13307025450 015212 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/function-list.R 0000644 0001762 0000144 00000001004 13007677542 015556 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/update-rate.R 0000644 0001762 0000144 00000002415 13341267235 015175 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/vignettes/ 0000755 0001762 0000144 00000000000 13356460607 014450 5 ustar ligges users ratelimitr/vignettes/introduction.Rmd 0000644 0001762 0000144 00000005150 13025641534 017627 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/README.md 0000644 0001762 0000144 00000010534 13307521077 013715 0 ustar ligges users ratelimitr
================
[](https://cran.r-project.org/package=ratelimitr) [](https://travis-ci.org/tarakc02/ratelimitr) [](https://codecov.io/github/tarakc02/ratelimitr?branch=master)
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.00 0.00 1.05
```
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 0 0
# 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.00 0.00 0.14
# similarly, 50 calls don't trigger the second rate limit
system.time(replicate(50, f_lim())); Sys.sleep(1)
#> user system elapsed
#> 0.00 0.00 0.56
# but 51 calls do:
system.time(replicate(51, f_lim())); Sys.sleep(1)
#> user system elapsed
#> 0.00 0.00 1.05
```
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.00 0.00 1.04
```
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/MD5 0000644 0001762 0000144 00000003655 13356471727 012766 0 ustar ligges users 0f5c95f4a87c201f0a48a6ec9d20d817 *DESCRIPTION
0dcc72e8b8541d0518394b9f2530d10f *LICENSE
1688e630ef73244ff193f7e597314694 *NAMESPACE
42910f569b97a717df0acd5b2dda2b6c *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
a251a193214cc57bfeed7aade4967b78 *README.md
ccf9a542cefe0d71d1ea80dda2f87e9a *build/vignette.rds
02661d7ddabac849e02781005fcc6ba9 *inst/doc/introduction.R
4a31389e8d86f777d9b914e2afecd46b *inst/doc/introduction.Rmd
34e0bd6572f15e38e6d41614c3fdfbea *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
20eb23db4486d8848dbcf7b2668a0d64 *tests/testthat/test-function-errors.R
4203ff9c339f698d1f2ddaba898b92f3 *tests/testthat/test-function-integrity.R
c590d0ccc89591e2cb678e0634388e13 *tests/testthat/test-limit-rate.R
62603cbe58d74ab96ac2c7545b980203 *tests/testthat/test-network-lag.R
98caa99d5a614174f614cc5a7ccea3fd *tests/testthat/test-repeated-calls.R
ad61b0d93755d121677f363227e686bc *tests/testthat/test-reset.R
bff5b33f23120df5c0568a4927b52fdb *tests/testthat/test-update-rate.R
37a2a7cc4ebfbeeaef0312f2de33bb96 *tests/testthat/test-window.R
4a31389e8d86f777d9b914e2afecd46b *vignettes/introduction.Rmd
ratelimitr/build/ 0000755 0001762 0000144 00000000000 13356460607 013537 5 ustar ligges users ratelimitr/build/vignette.rds 0000644 0001762 0000144 00000000326 13356460607 016077 0 ustar ligges users mQ
0 mM@Qv/WxkY+U;Sd䅞"HG %1 # 6ъJ#T9nOJ45R 7I#+mA T1>?qP{~o 8̬(̷ ,S\~OZpB ZVq54=k[/MZ ratelimitr/DESCRIPTION 0000644 0001762 0000144 00000001144 13356471726 014152 0 ustar ligges users Package: ratelimitr
Type: Package
Title: Rate Limiting for R
Version: 0.4.1
Author: Tarak Shah
Maintainer: Tarak Shah