R/order_by.R

In lessR: Less Code with More Comprehensive Results

order_by <-
function(data=d, by, direction=NULL, quiet=getOption("quiet"), ...) {


  if (missing(by)) {
    cat("\n"); stop(call.=FALSE, "\n","------\n",
      "Specify the variables to sort by first listing the data frame\n",
      "or preceding the variables with:  by\n\n")
  }

  # if a tibble, convert to data frame
  df.name <- deparse(substitute(data))  # the data frame name, or "NULL"
  if (exists(df.name, envir=parent.frame())) {
    if (any(grepl("tbl", class(data), fixed=TRUE)))
      data <- data.frame(data)
  }

  data.vars <- as.list(seq_along(data))
  names(data.vars) <- names(data)

  if (!quiet) {
    cat("\nSort Specification\n")
  }

  # do special keywords: row.names, random
  if (deparse(substitute(by)) == "row.names") {
    ord <- "order(row.names(data)"

    if (!is.null(direction)) {
      if (length(direction) != 1) {
        cat("\n"); stop(call.=FALSE, "\n","------\n",
          "Sorting by row.names takes exactly one direction value (+ or -).\n",
          "Number of direction values supplied: ", length(direction), "\n\n")
      }
      if (direction[1] == "+") txt <- "ascending"
      else if (direction[1] == "-") txt <- "descending"
      else {
        cat("\n"); stop(call.=FALSE, "\n","------\n",
        "Value of direction, the sort direction specification: ", direction[1],
        "\n\n",
        "Permissible values are + for ascending and - for descending.\n\n")
      }
    }
    else 
      txt <- "ascending"

    ord.txt <- "decreasing=FALSE"
    if (txt == "descending") ord.txt <- "decreasing=TRUE"
    ord <- paste(ord, ",", ord.txt, ",...)", sep="")
    if (!quiet) cat(" ", "row.names", "-->", txt, "\n")
  }  # end row.names

  else if (deparse(substitute(by)) == "random") {
    if (!quiet) cat(" ", "random\n")
    n.obs <- nrow(data)
    rand.rows <- sample(seq_len(n.obs), size=n.obs, replace=FALSE)
    ord <- paste("order(", "rand.rows", ", ...)", sep="")
  }  # end sort random

  else {  # sort variable(s)

    # columns to sort
    by.col <- eval(substitute(by), envir=data.vars, enclos=parent.frame())
    n.sort <- length(by.col)

    if (!is.null(direction)) {
      if (n.sort != length(direction)) { 
      cat("\n"); stop(call.=FALSE, "\n","------\n",
        "Number of specified variables to sort: ", n.sort, "\n",
        "Number of + and - signs to indicate direction of sort: ", 
          length(direction), "\n\n",
        "The same number of values must be specified for both\n",
        "the list of values and the list of the sort direction.\n\n")
      }
    }
    else
      direction <- rep("+", n.sort)

    # validate direction values
    for (i in seq_len(n.sort)) {
      if (!(direction[i] %in% c("+", "-"))) {
        cat("\n"); stop(call.=FALSE, "\n","------\n",
          "Value of direction, the sort direction specification: ",
          direction[i], "\n\n",
          "Permissible values are + for ascending and - for descending.\n\n")
      }
    }

    # console output
    if (!quiet) {
      for (i in seq_len(n.sort)) {
        nm <- names(data)[by.col[i]]
        txt <- if (direction[i] == "+") "ascending" else "descending"
        cat(" ", nm, "-->", txt, "\n")
      }
    }

    # construct the call to the order function
    ord <- ""
    for (i in seq_len(n.sort)) {  # xtfrm() needed for factors
      ord <- paste(ord, direction[i], 
                   "xtfrm(data[,by.col[", toString(i),"]])", sep="")
      if (i < n.sort) ord <- paste(ord, ",", sep="")
        
    }
    # forward ... to order() as the other branches do; empty ... is a no-op
    ord <- paste("order(", ord, ", ...)", sep="")
  }  # end sort variables


  # do the sort
  o <- eval(parse(text=ord))
  d <- data[o, , drop=FALSE]

  if (!quiet) cat("\n")
  return(d)

}