R/reshape_long.R

In lessR: Less Code with More Comprehensive Results

reshape_long <-
  function(data, transform, group="Group", response="Response", ID="ID",
           prefix=ID, sep="", shape=c("rect", "square"), reverse_y=NULL) {
 
  shape <- match.arg(shape)
  group.miss <- missing(group)
 
  # if a tibble, convert to data frame
  df.name <- deparse(substitute(data))  # is NULL if from shiny
  if (exists(df.name, envir=parent.frame())) {
    if (any(grepl("tbl", class(data), fixed=TRUE)))
      data <- data.frame(data)
  }

  if (shape == "rect") {
    if (is.null(ID)) ID <- "xxQ7q"

    data.vars <- as.list(seq_along(data))
    names(data.vars) <- names(data)
    ind <- eval(substitute(transform), envir=data.vars, parent.frame())
    # ind is integer when transform is a range (e.g. sup1:sup4) because data.vars
    # maps names to column positions; but a literal character vector passes through
    # eval() unchanged, so use it directly rather than subscripting names(data) by name
    if (is.character(ind))
      trns <- ind
    else
      trns <- names(data)[ind]

    dl <- reshape(data, direction="long", idvar=ID,
                    timevar=group, varying=trns,
                    v.names=response, times=trns)

    row.names(dl) <- seq_len(nrow(dl))

    if (ID == "xxQ7q")
      dl[,"xxQ7q"] <- NULL
    else {
      if (!is.null(prefix)) {
        ind <- which(names(dl) == ID)
        sp <- sep
        dl[,ind] <- paste(prefix, sp, dl[,ind], sep="") 
        # reorder with ID var first
        old.ind <- seq_len(ncol(dl))
        new.ind <- setdiff(old.ind, ind)
        new.ind <- c(ind, new.ind) 
        dl <- dl[,new.ind]
      }
    }
  }

  else { # shape is "square"

    var1 <- ifelse (group.miss, "Row", paste(group, 1, sep=""))
    var2 <- ifelse (group.miss, "Col", paste(group, 2, sep=""))

    dl <- as.data.frame(as.table(data))
    names(dl) <- c(var1, var2, response)

    # factor levels preserve original matrix order
    dl[,2] <- factor(dl[,2], levels = colnames(data))

    # reverse_y: reverse row-factor levels so the first row appears at the top
    # of a y-axis (which runs bottom-to-top). Defaults TRUE for square shape
    # because the primary use-case is a heat map, but can be set to FALSE.
    if (is.null(reverse_y)) {
      reverse_y <- TRUE
      message("reshape_long: for shape=\"square\", row levels are reversed by ",
              "default so the first row appears at the top of a heat map y-axis.\n",
              "  Set reverse_y=FALSE to keep the original row order.")
    }
    if (reverse_y)
      dl[,1] <- factor(dl[,1], levels = rev(rownames(data)))
    else
      dl[,1] <- factor(dl[,1], levels = rownames(data))
  }

  return(dl)

}