diff --git a/R/topics.R b/R/topics.R index b135eb3bc..9bf17c9fa 100644 --- a/R/topics.R +++ b/R/topics.R @@ -61,10 +61,11 @@ all_sign <- function(x, text) { } match_env <- function(topics) { - out <- env(empty_env(), + fns <- env(empty_env(), "-" = function(x) -x, "c" = function(...) c(...) ) + out <- env(fns) topic_index <- seq_along(topics$name) @@ -99,36 +100,36 @@ match_env <- function(topics) { is_public <- function(internal) { if (!internal) !topics$internal else rep(TRUE, nrow(topics)) } - out$starts_with <- function(x, internal = FALSE) { + fns$starts_with <- function(x, internal = FALSE) { any_alias(~ grepl(paste0("^", x), .), .internal = internal) } - out$ends_with <- function(x, internal = FALSE) { + fns$ends_with <- function(x, internal = FALSE) { any_alias(~ grepl(paste0(x, "$"), .), .internal = internal) } - out$matches <- function(x, internal = FALSE) { + fns$matches <- function(x, internal = FALSE) { any_alias(~ grepl(x, .), .internal = internal) } - out$contains <- function(x, internal = FALSE) { + fns$contains <- function(x, internal = FALSE) { any_alias(~ grepl(x, ., fixed = TRUE), .internal = internal) } - out$has_keyword <- function(x) { + fns$has_keyword <- function(x) { which(purrr::map_lgl(topics$keywords, ~ any(. %in% x))) } - out$has_concept <- function(x, internal = FALSE) { + fns$has_concept <- function(x, internal = FALSE) { match <- topics$concepts %>% purrr::map(~ str_trim(.) == x) %>% purrr::map_lgl(any) which(match & is_public(internal)) } - out$lacks_concepts <- function(x, internal = FALSE) { + fns$lacks_concepts <- function(x, internal = FALSE) { nomatch <- topics$concepts %>% purrr::map(~ match(str_trim(.), x, nomatch = FALSE)) %>% purrr::map_lgl(~ length(.) == 0L | all(. == 0L)) which(nomatch & is_public(internal)) } - out$lacks_concept <- out$lacks_concepts + fns$lacks_concept <- fns$lacks_concepts out }