#' Improved vector subsetting
#'
#' @param x a composer_vector
#' @param i standard indices used to subset
#' @param ... predicate subsetting functions applied on top off subset by indices
#' @export
#' @examples
#' vec <- co("A hello", "B hi")
#' vec[,~startsWith(.,"A")]
#' vec[1:2, ~startsWith(.,"A")]
#' vec[startsWith ="A"]
`[.composer_vector` <- function(x, i, ...) {
x <- unco(x)
if (!missing(i)) x <- x[i]
fs <- list(...)
if (length(fs)) {
fs <- harmonize_funs(fs,NULL)
x <- x[purrr::reduce(fs,~.y(x) & .x, .init = TRUE)]
}
co(x)
}
#' Apply composition of functions to vector
#'
#' It is essentially a wrapper around compose2 with additional feature for
#' easy string manipulation
#'
#' @param .x a composer_vector
#' @param .i a numeric vector, a character vector, a function or a formula
#' @param .j a numeric vector, a character vector, a function or a formula
#' @param ... additional arguments passed to compose2
#' @param .p a logical vector, a numeric vector, a function or a formula
#'
#' @export
#' @examples
#' vec <- co("A: hello there", "B: hi handsome")
#' vec[[4,-1,.p = 2:3]]
#' vec[[4,-1,.p = c(TRUE, FALSE)]] # recycled
#' vec[[4,-1,.p = ~startsWith(.,"A")]]
#' vec[["h."]]
#' vec[["(?<=\\s).*(?=\\s)"]]
#' vec[["e|a|o","X"]]
#' vec[[toupper]]
#' vec[[4,-1, ~toupper(.), paste = ";)"]]
#' str(vec[[.unco=T]])
`[[.composer_vector` <- function(.x, .i, .j, ..., .p = TRUE, .unco = FALSE) {
.x <- unco(.x)
# check arguments
if (missing(.i) && !missing(.j))
stop(".i can't be missing if .j is provided")
if (!isTRUE(.p)) {
# apply .p if it's a function/formula
if (inherits(.p,"formula") || is.function(.p))
.p <- purrr::as_mapper(.p)(.x) else if(
is.numeric(.p) && max(.p) > length(.x))
stop("incompatible index, max index is ",max(.p),
" and vector has length ", length(.x))
args <- as.list(match.call()[-1])
args$.x <- .x[.p]
args$.p <- TRUE
.x[.p] <- do.call(`[[.composer_vector`,args)
} else {
if (!missing(.i)) {
# use str_extract, str_replace_all or str_sub depending on
# .i and .j arguments
if (is.character(.i)) {
missing_end <- missing(.j) || is_fun_or_form(.j)
if (missing_end)
{ # i char j missing : str_extract
.x <- stringr::str_extract(.x, .i)}
else if (is.character(.j))
{ # i char j char : str_replace_all
.x <- stringr::str_replace_all(.x, .i, .j)}
else if (is.numeric(.j))
{ # i char j num : str_split
split_ <- stringr::str_split(.x,.i)
.x <- purrr::map_chr(split_,~`length<-`(.,max(lengths(split_)))[.j])
}
} else if (is.numeric(.i)) {
# i num j num / missing / function/formula : str_sub
if (missing(.j) && is.numeric(.i)) .j <- .i
if (!is.numeric(.j)) .j <- purrr::as_mapper(.j)(.x)
.x <- purrr::pmap_chr(list(as.character(.x), .i, .j), stringr::str_sub)
}
funs <- c(
if (is_fun_or_form(.i)) .i,
if (!missing(.j) && is_fun_or_form(.j)) .j,
list(...))
} else {
funs <- list(...)
}
if (length(funs))
.x <- rlang::invoke(compose2,funs)(.x)
}
if (.unco) .x else co(.x)
}
is_fun_or_form <- function(x){
is.function(x) || inherits(x,"formula")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.