#' Data-filtering conditions as vectors
#'
#' Creates a factor grid dataframe of data-filtering conditions for passing to additional to additional factorial-design functions.
#'
#' Formula-strings for filtering a data set based on the levels of crossed factors
#'
#' @importFrom magrittr %>%
#' @param .ind_var an independ. variation
#' @param .data a \code{factor.grid} dataframe generated by or
#' @param ... additional arguments
#' @return a data.frame of factorial-based filtering condition or a list for passing to additional
#' @family factorial-design functions
#' @export
#'
expand_factor_grid<-
function(.ind_var,
.data,
...) {
fg_dots <-
pryr::named_dots(...)
lapply(fg_dots, eval, parent.frame())
d <-
.data %>%
dplyr::select_(.dots = sweet_dots(.ind_var))
d2 <-
lapply(d[,1],
strsplit,
split = ":") %>%
unlist(recursive = FALSE)
lenNA <- c(is.na(d[1]))
d$len <- # Create "len" column
lapply(d2,length) %>%
stringr::str_c()
d$len[lenNA] <- "0"
d$lenNA <- lenNA
# len1 <- apply(d[2],1, FUN = function(x){ isTRUE(x==1)})
d$form <- sapply(d[,1],strsplit,":") %>%
stringr::str_c()
d$v <- d$form
d$v <- ifelse(d$len == 1,
paste0(paste0(.ind_var),' %in% c("',paste0(d$v),'")'),
ifelse(is.na(d$v),NA,
paste0(paste0(.ind_var)," %in% ",paste0(d$v))))
d$form <- d$v
d$sel <- paste0(.ind_var)
d$sel[lenNA] <- ""
d$v <-NULL
d$lenNA <-NULL
d <-
d %>%
`names<-`(c(paste0(.ind_var,c("_nm", "_len","_form.temp","_sel.temp"))))
d
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.