User supplied arguments for ordering a data.frame using arrange

Question

Suppose I have this data.frame:

df = data.frame(strain=c("I","I","R","R"),sex=c("M","F","M","F"),age=c("8d","8d","64d","64d"))

and a user supplied data.frame that defines how to order df. For example:

order.df = data.frame(column = c("age","sex","strain"),order = c("+","-","+"))

I would like to use arrange of plyr package to order df according to the order defined by order.df. If it wasn't user supplied I would just do:

arrange(df, age, desc(sex), strain)

So my question is how do I achieve that with order.df? or what ever data structure is appropriate to store the user supplied order definition so it can work with arrange.

Answer 1

Here are two approach that will probably make @hadley kill some kittens...

# make sure that order.df contain character not factors
r <- lapply(order.df, as.character)
# create a list of names refering the columns
rl <- lapply(r[['column']],function(x)list(column = as.name(x)))
# create the appropriate list of arguments
rexp <- unname(Map (f=function(order,column){
  cm <- force(column)
  if (order =='-'){rn <-substitute(desc(column),cm)} else {
  rn <- substitute(column,cm)}
  rn
}, order=r[['order']],column = rl))



do.call(arrange, c(alist(df=df),rexp))
#  strain sex age
#1      R   M 64d
#2      R   F 64d
#3      I   M  8d
#4      I   F  8d



#alternatively, use as.quoted...
fmts <- ifelse(r[['order']]=='-', 'desc(%s)','%s')
rexp2 <- lapply(unname(Map(fmt = fmts, f= sprintf,r[['column']])), 
                function(x) as.quoted(x)[[1]])

do.call(arrange, c(alist(df=df),rexp2))
#  strain sex age
#1      R   M 64d
#2      R   F 64d
#3      I   M  8d
#4      I   F  8d

Answer 2

I wouldn't recommend using arrange at all, since at heart it's a pretty simple wrapper around order(). Instead create your own wrapper:

my_order <- function(df, column, order) {
  stopifnot(is.data.frame(df))
  stopifnot(length(column) == length(order))

  # extract columns from df
  keys <- df[column]

  # reverse order if needed
  desc <- order == "-"
  keys[desc] <- lapply(keys[desc], function(x) -xtfrm(x))

  ord <- do.call("order", as.list(keys))
  df[ord, , drop = FALSE]
}

df <- data.frame(
  strain = c("I","I","R","R"),
  sex = c("M","F","M","F"),
  age = c("8d","8d","64d","64d")
)

my_order(df, c("age", "sex", "strain"), c("+", "-", "+"))

Answer 3

I can't even begin to fathom how to do this in the plyr-verse, but this works in base R:

ordinp <- Map(
  function(x,y) do.call(x,list(y)),
  c("rev","I")[order.df$order],
  df[as.character(order.df$column)]
)

with(df, df[do.call(order, ordinp),] )

#  strain sex age
#3      R   M 64d
#4      R   F 64d
#1      I   M  8d
#2      I   F  8d

Compare:

arrange(df, age, desc(sex), strain)

#  strain sex age
#1      R   M 64d
#2      R   F 64d
#3      I   M  8d
#4      I   F  8d

Answer 4

Here is another option using data.table:

require("data.table")
DT <- as.data.table(df)

# Create a new variable with the text to be evaluated
order.df$order_dt <- ifelse(
  order.df$order == "+", as.character(order.df$column), 
  paste0("-rank(",order.df$column,")")
  )

expr <- paste0("order(",paste0(order.df$order_dt, collapse = ","),")",collapse="")

DT[eval(parse(text=expr))]

#    strain sex age
# 1:      R   M 64d
# 2:      R   F 64d
# 3:      I   M  8d
# 4:      I   F  8d

### Another option. 
### This could handle more operations at the same time

EVAL = function(...)eval(parse(text=paste0(...)))
EVAL("DT[", expr, "]")

Same approach Using Plyr

require("plyr")
arrange(df, age, desc(sex), strain)

order.df$order_dt <- ifelse(
  order.df$order == "+", as.character(order.df$column), 
  paste0("desc(",order.df$column,")")
)

expr <- paste0("arrange(df,",paste0(order.df$order_dt, collapse = ","),")",collapse="")

eval(parse(text=expr))