random_bytes <- function(n) {
as.raw(sample(2^8, n, TRUE) - 1L)
}
pad <- function(x, len, with = 0) {
c(x, rep_len(as.raw(with), len - length(x)))
}
repr <- function(x, ...) {
as.raw(rep(x, ...))
}
fill_buffer <- function(x, len) {
if (is.character(x)) {
x <- charToRaw(x)
} else {
x <- as.raw(x)
}
rep(x, length.out = len)
}
## The length of test_pattern should not fit naturally into size, or
## else it won't be possible to detect proper wrapping of the head
## pointer.
test_pattern <- function(size) {
fill_buffer((size + 1) * 2, "abcdefghijk")
}
first <- function(x) {
head(x, 1L)
}
last <- function(x) {
tail(x, 1L)
}
SEARCH_TYPES <- c("linear", "bisect")
test_search_linear <- function(buffer, value, i) {
.Call(Ctest_search_linear, buffer, as.double(value))
}
test_search_bisect <- function(buffer, value, i = 0L) {
.Call(Ctest_search_bisect, buffer, as.double(value), as.integer(i))
}
test_search <- function(buffer, value, type, i = 0L) {
search <- switch(type,
linear = test_search_linear,
bisect = test_search_bisect,
stop("Invalid search type"))
search(buffer, value, i)
}
test_advance_head <- function(b, v) {
.Call(Ctest_advance_head, b$.ptr, v)
}
viapply <- function(X, FUN, ...) {
vapply(X, FUN, integer(1), ...)
}
pool <- function(type, n) {
pool <- switch(type,
logical = c(TRUE, FALSE, NA),
integer = as.integer(1:50),
double = rnorm(50),
complex = complex(real = rnorm(20), imaginary = rnorm(20)))
sample(pool, n, TRUE)
}
## I am continuing to have horrid problems with system.file when
## working under devtools, or which versions are broken. This
## workaround is ported from dde.
PATH_RING <- system.file(package = "ring")
if (!nzchar(PATH_RING)) {
PATH_RING <- "../../inst"
}
load_ring_vector <- function(env = parent.frame()) {
sys.source(file.path(PATH_RING, "examples", "ring_vector.R"), env)
}
load_ring_matrix <- function(env = parent.frame()) {
sys.source(file.path(PATH_RING, "examples", "ring_vector.R"), env)
sys.source(file.path(PATH_RING, "examples", "ring_matrix.R"), env)
}
on_ci <- function() {
isTRUE(as.logical(Sys.getenv("CI")))
}
on_windows <- function() {
tolower(Sys.info()[["sysname"]]) == "windows"
}
skip_on_windows_gha <- function() {
if (on_ci() && on_windows()) {
testthat::skip("On Windows Github Actions")
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.