reps_each <- as.integer(cumprod(c(1, ns))[1:n])
reps_whole <- as.integer(total/(ns * reps_each))
lst <- list(1:400, 1:400, 1:20)
sub <- list(1:400, 1:400, 1:20)
n <- length(x.dim)
ns <- collapse::vlengths(sub)
total <- as.integer(prod(ns))
reps_each <- as.integer(cumprod(c(1, ns))[1:n])
reps_whole <- as.integer(total/(ns * reps_each))
squarebrackets:::.rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod)
foo <- bench::mark(
squarebrackets:::.rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod),
rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod)
)
foo
Rcpp::cppFunction(
"
IntegerVector rcpp_sub2ind_general(
List lst, int total, IntegerVector reps_each, IntegerVector reps_whole, IntegerVector xdim, IntegerVector dimcumprod
) {
int ndim = lst.length();
Rcpp::IntegerVector out(total);
IntegerVector temp = lst[0];
out = rep(temp, reps_whole[0]);
if(ndim > 1) {
for(int j = 1; j < ndim; ++j) {
int myprod = dimcumprod[j - 1];
temp = lst[j];
R_xlen_t n = temp.length() * reps_each[j];
for(int i = 0; i < reps_whole[j]; ++i) {
Range myrng = Range(n * i, n * (i + 1) - 1);
IntegerVector temp2 = rep_each(temp, reps_each[j]);
out[myrng] = out[myrng] + (temp2 - 1) * myprod;
}
}
}
return(out);
}
"
)
x.dim <- c(500, 500, 30)
dimcumprod <- as.integer(cumprod(x.dim))
x.len <- prod(x.dim)
x <- array(1:x.len, x.dim)
sub <- list(1:400, 1:400, 1:20)
n <- length(x.dim)
ns <- collapse::vlengths(sub)
total <- as.integer(prod(ns))
reps_each <- as.integer(cumprod(c(1, ns))[1:n])
reps_whole <- as.integer(total/(ns * reps_each))
foo <- bench::mark(
squarebrackets:::.rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod),
rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod)
)
foo
foo <- bench::mark(
squarebrackets:::.rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod),
rcpp_sub2ind_general(lst, total, reps_each, reps_whole, x.dim, dimcumprod),
min_iterations = 500
)
foo
?match.call
fun <- function(a, b, ...) {match.call()}
fun()
fun <- function(a, b, ...) {print(match.call())}
fun()
fun
fun <- function(a, b, ...) {print(as.list(match.call()))}
fun
fun()
fun(a=1)
?collapse::fmode
?abind::adrop
?abind::acorn
abind::acorn
abind:::acorn.default
?abind::afill
abind::afill
abind::`afill<-`
abind:::`afill<-.default`
?abind::asub
?Subscript
?data.table::uniqueN
data.table::uniqueN
?squarebrackets
?squarebrackets::`squarebrackets-package`
?`squarebrackets-package`
?squarebrackets::`squarebrackets-package`
?idx_by
library(squarebrackets)
?idx_by
x <- data.table::data.table(a=1:10, b=letters[1:10])
dimnames(x)
dim(x)
?collapse:::BY
library(tinycodet)
library(ggplot2)
loadNamespace("bench")
n <- 1e5
x <- rep(paste0(1:50, collapse = ""), n)
p <- "\\d"
i <- sample(c(-50:-1, 1:50), replace=TRUE, size = n)
locate_stringi <- function(...) {
stringi::stri_locate_all(...)
stringi::stri_count(...)
}
bm.stri_locate_ith <- bench::mark(
"stri_locate_ith" = stri_locate_ith_regex(x, p, i),
"stringi::(stri_locate_all + stri_count)" = locate_stringi(x, regex = p),
min_iterations = 500,
check = FALSE,
filter_gc = FALSE
)
summary(bm.stri_locate_ith)
autoplot(bm.stri_locate_ith)
?getNamespaceExports
getNamespaceExports
?.getNamespaceInfo()
.getNamespaceInfo()
.getNamespaceInfo
library(tinycodet)
expect_equal(
sort(tinycodet:::.internal_list_coreR()),
sort(c(
"base", "compiler", "datasets", "grDevices", "graphics", "grid", "methods",
"parallel", "splines", "stats", "stats4", "tcltk", "tools",
"translations", "utils"
))
)
expect_equal(
sort(tinycodet:::.internal_list_preinst()),
sort(c(
"boot", "class", "cluster", "codetools", "foreign", "KernSmooth",
"lattice", "MASS", "Matrix",  "mgcv", "nlme", "nnet",
"rpart", "spatial", "survival"
))
)
library(tinytest)
expect_equal(
sort(tinycodet:::.internal_list_coreR()),
sort(c(
"base", "compiler", "datasets", "grDevices", "graphics", "grid", "methods",
"parallel", "splines", "stats", "stats4", "tcltk", "tools",
"translations", "utils"
))
)
expect_equal(
sort(tinycodet:::.internal_list_preinst()),
sort(c(
"boot", "class", "cluster", "codetools", "foreign", "KernSmooth",
"lattice", "MASS", "Matrix",  "mgcv", "nlme", "nnet",
"rpart", "spatial", "survival"
))
)
expect_equal(
sort(tinycodet:::.internal_list_knownmeta()),
sort(c("tidyverse", "fastverse", "tinyverse"))
)
expect_equal(
sort(tinycodet:::.internal_list_tidyshared()),
sort(c("rlang", "lifecycle", "cli", "glue", "withr"))
)
expect_error(
tinycodet:::.internal_check_forbidden_pkgs(
c("tidyverse", "fastverse", "tinyverse"), lib.loc, abortcall = sys.call()
),
pattern = paste0(
"The following packages are known meta-verse packages, which is not allowed:",
"\n",
"tidyverse, fastverse, tinyverse"
),
fixed = TRUE
)
# check rcpp internal function does NOT modify by reference ====
lib.loc <- .libPaths()
package <- "stringi"
ns <- as.list(loadNamespace(package, lib.loc = lib.loc),
all.names = TRUE, sorted = TRUE)
names_exported <- names(ns[[".__NAMESPACE__."]][["exports"]])
ns <- ns[names_exported]
ns <- ns[!is.na(names(ns))]
names_exported <- names(ns)
names_functions <- names(ns)[
unlist(vapply(ns, is.function, FUN.VALUE = logical(1)), use.names = FALSE)
]
ns2 <- ns
ns <- tinycodet:::.rcpp_prep_ns(ns, names_functions, package)
out <- mapply(identical, ns, ns2)
expect_false(
any(out)
)
import_as(~stri., "stringi")
# attr.import ====
myattr <- attr.import(stri.)
expect_equal(
myattr$tinyimport,
"tinyimport"
)
expect_equal(
attr.import(stri., "pkgs"),
myattr$pkgs
)
expect_equal(
attr.import(stri., "conflicts"),
myattr$conflicts
)
attr.import(stri., "versions")
find.package
library(tinytest)
library(tinycodet)
# set working directory to source file location ====
SourceFileLocation <- function() {
# BATCH way:
path <- funr::get_script_path()
if(!is.null(path)) return(path)
# R-Studio way:
if(Sys.getenv("RSTUDIO") == "1") {
if(rstudioapi::isAvailable(version_needed = NULL,child_ok = FALSE)) {
return(dirname(rstudioapi::getSourceEditorContext()$path))
}
if(is.null(knitr::current_input(dir = TRUE)) == FALSE) {
return(knitr::current_input(dir = TRUE))
}
return(getwd())
}
}
wd <- SourceFileLocation()
setwd(wd)
setwd("..")
# count number of "expect_" occurrences ====
testfiles <- list.files(file.path(getwd(), "/"), pattern = "*.R", recursive = TRUE)
n.testfiles <- length(testfiles)
temp.fun <- function(x) {
foo <- readLines(file.path(x))
sum(stringi::stri_count(foo, regex="expect_"))
}
testcount_regular <- sapply(
testfiles,
FUN = temp.fun
) |> sum()
# count number of loop iterated tests ====
n.iterations <- 0
n.loops <- 0
testfiles <- list.files(file.path(getwd(), "safer"), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(),"safer", i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
testfiles <- list.files(file.path(getwd(), "import"), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(),"import", i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
testfiles <- list.files(file.path(getwd(), "strings"), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(),"strings", i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
testfiles <- list.files(file.path(getwd(), "dry"), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(),"regular", i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
testfiles <- list.files(file.path(getwd(), "dry"), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(),"dry", i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
testcount_loops <- n.iterations - n.loops
# determine total number of tests ====
testcount_total <- testcount_regular + testcount_loops
print(testcount_total)
testfiles <- list.files(file.path(getwd()), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(), i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
library(tinytest)
library(tinycodet)
# set working directory to source file location ====
SourceFileLocation <- function() {
# BATCH way:
path <- funr::get_script_path()
if(!is.null(path)) return(path)
# R-Studio way:
if(Sys.getenv("RSTUDIO") == "1") {
if(rstudioapi::isAvailable(version_needed = NULL,child_ok = FALSE)) {
return(dirname(rstudioapi::getSourceEditorContext()$path))
}
if(is.null(knitr::current_input(dir = TRUE)) == FALSE) {
return(knitr::current_input(dir = TRUE))
}
return(getwd())
}
}
wd <- SourceFileLocation()
setwd(wd)
setwd("..")
# count number of "expect_" occurrences ====
testfiles <- list.files(file.path(getwd(), "/"), pattern = "*.R", recursive = TRUE)
n.testfiles <- length(testfiles)
temp.fun <- function(x) {
foo <- readLines(file.path(x))
sum(stringi::stri_count(foo, regex="expect_"))
}
testcount_regular <- sapply(
testfiles,
FUN = temp.fun
) |> sum()
# count number of loop iterated tests ====
n.iterations <- 0
n.loops <- 0
testfiles <- list.files(file.path(getwd()), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(), i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
for(iSubDir in c("safer", "import", "strings", "dry")) {
testfiles <- list.files(file.path(getwd(), iSubDir), pattern = "*.R", recursive = FALSE)
for(iFile in testfiles) {
my_env <- new.env()
source(file.path(getwd(), iSubDir, iFile), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
}
testcount_loops <- n.iterations - n.loops
# determine total number of tests ====
testcount_total <- testcount_regular + testcount_loops
print(testcount_total)
# test / function ratio ====
nfuns <- length(getNamespaceExports(loadNamespace("tinycodet")))
testcount_total / nfuns # about 72 tests per function on average
library(tinytest)
library(tinycodet)
# set working directory to source file location ====
SourceFileLocation <- function() {
# BATCH way:
path <- funr::get_script_path()
if(!is.null(path)) return(path)
# R-Studio way:
if(Sys.getenv("RSTUDIO") == "1") {
if(rstudioapi::isAvailable(version_needed = NULL,child_ok = FALSE)) {
return(dirname(rstudioapi::getSourceEditorContext()$path))
}
if(is.null(knitr::current_input(dir = TRUE)) == FALSE) {
return(knitr::current_input(dir = TRUE))
}
return(getwd())
}
}
wd <- SourceFileLocation()
setwd(wd)
setwd("..")
# count number of "expect_" occurrences ====
testfiles <- list.files(file.path(getwd(), "/"), pattern = "*.R", recursive = TRUE)
n.testfiles <- length(testfiles)
temp.fun <- function(x) {
foo <- readLines(file.path(x))
sum(stringi::stri_count(foo, regex="expect_"))
}
testcount_regular <- sapply(
testfiles,
FUN = temp.fun
) |> sum()
# count number of loop iterated tests ====
n.iterations <- 0
n.loops <- 0
testfiles <- list.files(file.path(getwd()), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(), i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
for(iSubDir in c("safer", "import", "strings", "dry")) {
testfiles <- list.files(file.path(getwd(), iSubDir), pattern = "*.R", recursive = FALSE)
for(iFile in testfiles) {
my_env <- new.env()
source(file.path(getwd(), iSubDir, iFile), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
}
testcount_loops <- n.iterations - n.loops
# determine total number of tests ====
testcount_total <- testcount_regular + testcount_loops
print(testcount_total)
# test / function ratio ====
nfuns <- length(getNamespaceExports(loadNamespace("tinycodet")))
testcount_total / nfuns # about 73.5 tests per function on average
# test / function ratio ====
nfuns <- length(getNamespaceExports(loadNamespace("tinycodet"))) - 5 # 5 aliases
testcount_total / nfuns # about 73.5 tests per function on average
?stri_c_mat
# test / function ratio ====
nfuns <- length(getNamespaceExports(loadNamespace("tinycodet"))) - 4 # 4 aliases
testcount_total / nfuns # about 78 tests per function on average
rm(list = ls())
rm(list = ls())
library(tinytest)
library(tinycodet)
# set working directory to source file location ====
SourceFileLocation <- function() {
# BATCH way:
path <- funr::get_script_path()
if(!is.null(path)) return(path)
# R-Studio way:
if(Sys.getenv("RSTUDIO") == "1") {
if(rstudioapi::isAvailable(version_needed = NULL,child_ok = FALSE)) {
return(dirname(rstudioapi::getSourceEditorContext()$path))
}
if(is.null(knitr::current_input(dir = TRUE)) == FALSE) {
return(knitr::current_input(dir = TRUE))
}
return(getwd())
}
}
wd <- SourceFileLocation()
setwd(wd)
setwd("..")
# count number of "expect_" occurrences ====
testfiles <- list.files(file.path(getwd(), "/"), pattern = "*.R", recursive = TRUE)
n.testfiles <- length(testfiles)
temp.fun <- function(x) {
foo <- readLines(file.path(x))
sum(stringi::stri_count(foo, regex="expect_"))
}
testcount_regular <- sapply(
testfiles,
FUN = temp.fun
) |> sum()
# count number of loop iterated tests ====
n.iterations <- 0
n.loops <- 0
testfiles <- list.files(file.path(getwd()), pattern = "*.R", recursive = FALSE)
for(i in testfiles) {
my_env <- new.env()
source(file.path(getwd(), i), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
for(iSubDir in c("safer", "import", "strings", "dry")) {
testfiles <- list.files(file.path(getwd(), iSubDir), pattern = "*.R", recursive = FALSE)
for(iFile in testfiles) {
my_env <- new.env()
source(file.path(getwd(), iSubDir, iFile), local = my_env) |> suppressMessages()
if("enumerate" %in% names(my_env) && "loops" %in% names(my_env)){
print(my_env$enumerate)
n.iterations <- n.iterations + my_env$enumerate
n.loops <- n.loops + my_env$loops
}
}
}
testcount_loops <- n.iterations - n.loops
# determine total number of tests ====
testcount_total <- testcount_regular + testcount_loops
print(testcount_total)
# test / function ratio ====
nfuns <- length(getNamespaceExports(loadNamespace("tinycodet"))) - 4 # 4 aliases
testcount_total / nfuns # about 77 tests per function on average
# test / function ratio ====
nfuns <- length(getNamespaceExports(loadNamespace("tinycodet")))
nfuns <- nfuns - 4 # because there were 4 aliases
testcount_total / nfuns # about 77 tests per function on average
