R/in_progress_functions/expand_factor_grid-function.R

In darrellpenta/dissertate: Convenience functions for writing a dissertation (Cognitive Science, etc)

#' 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
}