R/wrap.split.R

In michaelkardas/behavioralwrappers: Wrappers and other functions for the behavioral sciences

#' Split a data frame
#'
#' @description Splits a data frame across all combinations of 1-3 independent
#' variables and then assigns the new data frames to the Global Environment.
#' The function delegates the primary computations to \code{\link[base]{split}}.
#'
#' @param df The data frame that you intend to split
#' @param iv1,iv2,iv3 Names of the columns containing the independent variables
#'
#' @seealso \code{\link[base]{split}}
#'
#' @examples
#' ## Splitting a data frame by 1 independent variable
#' wrap.split(df = bdata, iv1 = IV1)
#'
#' ## Splitting a data frame by 2 independent variables
#' wrap.split(df = bdata, iv1 = IV1, iv2 = IV2)
#' @import stringr
#' @export
wrap.split <- function(df, iv1, iv2 = NULL, iv3 = NULL) {

  if(is.null(substitute(iv1))==F) {if(is.character(substitute(iv1))) {iv1 <- noquote(iv1)}}
  if(is.null(substitute(iv2))==F) {if(is.character(substitute(iv2))) {iv2 <- noquote(iv2)}}
  if(is.null(substitute(iv3))==F) {if(is.character(substitute(iv3))) {iv3 <- noquote(iv3)}}

  # Error checks
  if(is.null(substitute(iv1))==T&(is.null(substitute(iv2))==F|is.null(substitute(iv3))==F)) {return("Must enter iv1 before iv2 or iv3.")}
  if(is.null(substitute(iv2))==T&is.null(substitute(iv3))==F) {return("Must enter iv2 before iv3.")}
  if(as.character(substitute(iv1)) %in% names(df) == F) {return(paste("Cannot find column ",substitute(iv1)," in the data frame.",sep=""))}
  if(is.null(substitute(iv2))==F) {if(as.character(substitute(iv2)) %in% names(df) == F) {return(paste("Cannot find column ",substitute(iv2)," in the data frame.",sep=""))}}
  if(is.null(substitute(iv3))==F) {if(as.character(substitute(iv3)) %in% names(df) == F) {return(paste("Cannot find column ",substitute(iv3)," in the data frame.",sep=""))}}

  # split by iv1
  try(A <- split(df, factor(eval(parse(text=paste(substitute(df),"$",substitute(iv1),sep=""))))), silent=T)
  names(A) <- paste0(substitute(df),".", names(A))
  list2env(A, envir=.GlobalEnv)

  if (is.null(substitute(iv2))==F) {

    # split by iv2
    B <- split(df, factor(eval(parse(text=paste(substitute(df),"$",substitute(iv2),sep="")))))
    names(B) <- paste0(substitute(df),".", names(B))
    list2env(B, envir=.GlobalEnv)

    for (i in 1:length(A)) {

      # split by iv1 and iv2
      C <- split(data.frame(A[i]),factor(eval(parse(text=paste(names(A)[i],"$",substitute(iv2),sep="")))))
      names(C) <- paste0((names(A)[i]),".", names(C))

      for (j in 1:length(C)) {
        colnames(C[[j]]) <- substring(colnames(C[[j]]),nchar(names(A)[i])+2)
      }
      list2env(C, envir=.GlobalEnv)
    }
  }

  # split by iv3
  if (is.null(substitute(iv2))==F & is.null(substitute(iv3))==F) {

    D <- split(df, factor(eval(parse(text=paste(substitute(df),"$",substitute(iv3),sep="")))))
    names(D) <- paste0(substitute(df),".", names(D))
    list2env(D, envir=.GlobalEnv)

    for (i in 1:length(A)) {

      # split by iv1 and iv2
      C <- split(data.frame(A[i]),factor(eval(parse(text=paste(names(A)[i],"$",substitute(iv2),sep="")))))
      names(C) <- paste0(names(A)[i],".", names(C),sep="")

      for (j in 1:length(C)) {
        colnames(C[[j]]) <- substring(colnames(C[[j]]),nchar(names(A)[i])+2)
      }

      # split by iv1 and iv3
      X <- split(data.frame(A[i]),factor(eval(parse(text=paste(names(A)[i],"$",substitute(iv3),sep="")))))
      names(X) <- paste0(names(A)[i],".", names(X),sep="")

      for (j in 1:length(X)) {
        colnames(X[[j]]) <- substring(colnames(X[[j]]),nchar(names(A)[i])+2)
      }

      for (j in 1:length(names(C))) {

        # split by iv1, iv2, and iv3
        E <- split(data.frame(C[j]),factor(eval(parse(text=paste(names(C)[j],"$",substitute(iv3),sep="")))))
        names(E) <- paste0(names(C)[j],".", names(E),sep="")

        for (k in 1:length(names(E))) {
          colnames(E[[k]]) <- substring(colnames(E[[k]]),nchar(names(C)[j])+2)
        }
        list2env(E, envir=.GlobalEnv)
        list2env(X, envir=.GlobalEnv)
      }
    }

    for (i in 1:length(B)) {
      # split by iv2 and iv3
      G <- split(data.frame(B[i]),factor(eval(parse(text=paste(names(B)[i],"$",substitute(iv3),sep="")))))
      names(G) <- paste0(names(B)[i],".", names(G),sep="")

      for (j in 1:length(G)) {
        colnames(G[[j]]) <- substring(colnames(G[[j]]),nchar(names(B)[i])+2)
      }
      list2env(G, envir=.GlobalEnv)
    }
  }
}