R/my.split.R

In michaelkardas/temp.functions2:

#' Splits a data frame by combinations of 1-3 independent variables.
#' @param data Data frame to split.
#' @keywords
#' @export
#' @examples
#' my.split(v08,exposure,technique)

my.split <- function(data, iv1, iv2 = NULL, iv3 = NULL) {

  library(stringr)

  # Wrong data frame warning.
  fargs <- as.list(match.call(expand.dots = TRUE)); for (i in 1:length(fargs)) {fargs[i] <- gsub("*","",fargs[i],fixed=T); fargs[i] <- gsub("-","",fargs[i],fixed=T); fargs[i] <- gsub(" ", "", fargs[i],fixed=T)};  fargs2 <- NULL; for (i in 2:length(fargs)) {if(is.na(str_locate_all(pattern=coll('$'),toString(fargs[i][[1]]))[[1]][1])==F|is.na(str_locate_all(pattern=coll('['),toString(fargs[i][[1]]))[[1]][1])==F) {fargs2 <- c(fargs2,substr(fargs[2][[1]],1,str_locate_all(pattern=coll('$'),toString(fargs[i][[1]]))[[1]][1]-1))}; {fargs2 <- c(fargs2,substr(fargs[2][[1]],1,str_locate_all(pattern=coll('['),toString(fargs[i][[1]]))[[1]][1]-1))}}; fargs2 <- fargs2[!is.na(fargs2)]; if(length(fargs2)>=2) {for (i in 2:length(fargs2)) {if(fargs2[i-1]!=fargs2[i]) {warning("WARNING: Multiple data frames entered as function arguments.")}}}

  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.")}

  # split by iv1
  try(A <- split(data, factor(eval(parse(text=paste(substitute(data),"$",substitute(iv1),sep=""))))), silent=T)
  if(exists("A")==F) {stop("NOTE: You likely mistyped the name of a column. Otherwise, note that objects name ''raw'' cause idiosyncratic but consistent errors in this function.")}
  names(A) <- paste0(substitute(data),".", names(A))
  list2env(A, envir=.GlobalEnv)

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

    # split by iv2
    B <- split(data, factor(eval(parse(text=paste(substitute(data),"$",substitute(iv2),sep="")))))
    names(B) <- paste0(substitute(data),".", 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(data, factor(eval(parse(text=paste(substitute(data),"$",substitute(iv3),sep="")))))
    names(D) <- paste0(substitute(data),".", 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)
    }
  }
}