Can you prevent factor coercion when summarising with `data.table` and `c()`?

Viewed 61

I'd like to be able to use both a summarising function and a standard expression in data.table have found that c() works quite well, but it coerces factors into their integer representation.

Is there a simple way in data.table that I can use both a named list summary and a summary with a factor value, and retain the actual factor class without it being converted to an integer?

library(data.table)
library(lubridate)
data <- data.table(date = ymd("2019-07-07","2018-05-04",
                          "2019-08-09","2017-06-03"),
                   colour = factor(c("red","blue","green","yellow")),
           group = factor(c("A","B","A","B")),
           value1 = c(5,23,3,1),
           value2 = c(3,2,4,1))

summary_func <- function(x, var_name){
  setNames(list(mean(x),
       sd(x)), paste0(var_name,"_",c("mean","sd")))
}

data[,c(summary_func(value1,var_name = "val1"),
        summary_func(value2,var_name = "val2"),
        first_colour = colour[1]),
     by = group]

Result:

   group val1_mean   val1_sd val2_mean   val2_sd first_colour
1:     A         4  1.414214       3.5 0.7071068            3
2:     B        12 15.556349       1.5 0.7071068            1

I'd like the result to be:

   group val1_mean   val1_sd val2_mean   val2_sd first_colour
1:     A         4  1.414214       3.5 0.7071068        green
2:     B        12 15.556349       1.5 0.7071068          red

I have had some success below, but these solutions are very inelegant and I suspect not very generalisable. Therefore, I'm hoping there is a more concise data.table method for solving this problem.

Things I have tried:

  1. I found that I could achieve the result by using a list() around the list summaries, and giving them a very specific naming convention ("SF"). You then need to sort the columns into the list columns and the non-list columns, and then use cbind, lapply, and rbindlist to coerce the lists into data.tables. You then have to rename the resulting columns.
tmp1 <- data[,.(first_colour = colour[1],
               SF1 = list(summary_func(value1, "val1")),
               SF2 = list(summary_func(value2, "val2"))),
    by = group]
list_cols <- names(which(sapply(tmp1,is.list)))
grp_cols <- names(tmp1)[!names(tmp1) %in% list_cols]

tmp2 <- tmp1[, do.call(cbind, 
                       c(lapply(mget(list_cols),rbindlist),
                         deparse.level = 0)), by = grp_cols]
setnames(tmp2, gsub("^SF\\d\\.", "", names(tmp2)))
tmp2
  1. I found that if you create an alternate version of c() you can get the desired behaviour. You need to unpack the arguments in a specific way so as to preserve types and names. I think though that this is likely to be very slow relative to c() and list() since both of those functions are primatives and so based on compiled C code.
c_alt <- function(...){
   blah <- list(...)
   result <- list()
   for(i in 1:length(blah)){
      len <- length(blah[[i]])
      for(j in 1:len){
         result[[length(result) + 1]] <- blah[[i]][[j]]
      }
      if(len > 1){
         names(result)[(length(result)-len):length(result)] <- names(blah[[i]])
      }else{
         names(result)[[length(result)]] <- names(blah)[[i]]
      }
   }
   result
}

data[,c_alt(summary_func(value1,var_name = "val1"),
        summary_func(value2,var_name = "val2"),
        first_colour = colour[1]),
     by = group]
3 Answers

One way would be to convert colour to character, extract the 1st value and make it factor again if needed.

library(data.table)

data[,c(summary_func(value1,var_name = "val1"),
        summary_func(value2,var_name = "val2"),
        first_colour = as.character(colour[1])),
     by = group][, first_colour := factor(first_colour)][]

#   group val1_mean   val1_sd val2_mean   val2_sd first_colour
#1:     A         4  1.414214       3.5 0.7071068          red
#2:     B        12 15.556349       1.5 0.7071068         blue

c doesn't allow different types:

All arguments are coerced to a common type which is the type of the returned value

You could use data.frames with cbind.
This preserves the columns types:

summary_func <- function(x, var_name){
  setNames(data.frame(mean(x),
                      sd(x)), paste0(var_name,"_",c("mean","sd")))
}

data[,cbind(summary_func(value1,var_name = "val1"),
            summary_func(value2,var_name = "val2"),
            data.frame(first_colour = colour[1])),
     by = group]

   group val1_mean   val1_sd val2_mean   val2_sd first_colour
1:     A         4  1.414214       3.5 0.7071068          red
2:     B        12 15.556349       1.5 0.7071068         blue

If you're happy to use the dplyr & tidyr packages, this gives the required output and is extendable if you want to add more summarise functions:

library(dplyr)
library(tidyr)

data %>% 
      pivot_longer(-c(date, colour, group), names_to = "column", values_to = "val") %>% 
      mutate(column = if_else(column == "value1", "val1", "val2")) %>% 
      group_by(group, column) %>% 
      summarise(mean = mean(val), sd = sd(val), colour = colour[1]) %>% 
      pivot_wider(id_cols = c(group, colour), names_from = column, values_from = c(mean, sd))  %>% 
      relocate(colour, .after = last_col())
Related