uReshape.R

uReshape <- function(data, id.vars, var.stubs, sep) {
  vGrep <- Vectorize(grep, "pattern", SIMPLIFY = FALSE)
  temp <- names(data)[names(data) %in% 
                        unlist(vGrep(var.stubs, names(data), 
                                     value = TRUE))]
  
  if (sep == "NoSep") {
    x <- NoSep(temp, ...)
  } else {
    x <- do.call(rbind.data.frame, 
                 strsplit(temp, split = sep))
    names(x) <- 
      c("VAR", paste(".time", 1:(length(x)-1), sep = "_"))
  }

  xS <- split(x$.time_1, x$VAR)
  xL <- unique(unlist(xS))
  
  if (isTRUE(all(sapply(xS, function(x) all(xL %in% x))))) {
    reshape(data, direction = "long", idvar = id.vars, 
            varying = lapply(vGrep(var.stubs, names(data), value = TRUE), sort), 
            sep = sep, v.names = var.stubs)
  } else {
    newVars <- unlist(lapply(names(xS), function(y) {
      temp <- xL[!xL %in% xS[[y]]]
      if (length(temp) == 0) {
        temp <- NULL
      } else {
        paste(y, temp, sep = sep)
      }
    }))
    myMat <- setNames(
      data.frame(matrix(NA, nrow = nrow(data), ncol = length(newVars))),
      newVars)
    out <- cbind(data, myMat)
    reshape(out, direction = "long", idvar = id.vars,
            varying = lapply(vGrep(var.stubs, names(out), 
                                   value = TRUE), sort), 
            sep = sep, v.names = var.stubs)
  }
}