CODEWITHSUNDEEP
rdataframedplyr
vctrd
vctrd

Reputation: 518

Apply a function by row on a dataframe independently of the number of columns

I'd like to apply a function by rows on a data.frame to concatenate column titles depending on the value in the row.

df 
      A     B
1  TRUE  TRUE
2 FALSE  TRUE
3 FALSE FALSE

      A     B Result
1  TRUE  TRUE A / B
2 FALSE  TRUE   B
3 FALSE FALSE NA

I read about dplyr using mutate() and rowwise(), but I don't know how to apply them since the columns aren't constants.

for a row "i" I would do something like:

paste(names(df)[as.logical(df[i,])], collapse = ' / ')

Any help would be welcome.

Thank you.

Upvotes: 3

Views: 226

Answers (2)

akrun
akrun

Reputation: 887088

If the dataset is not really big (i.e. in millions/billions of rows) we can use apply with MARGIN=1 to loop over the rows, subset the names of the vector using the logical vector as index and paste them together. It is easier to code in a single line.

df$Result <- apply(df, 1, FUN = function(x) paste(names(x)[x], collapse=" / "))

However, if we have a big dataset, another option is to create a key/value pair and replace the values by matching and it is faster than the above solution.

v1 <- do.call(paste, df)
unname(setNames(c("A / B", "B", "A", NA), do.call(paste, 
          expand.grid(rep(list(c(TRUE, FALSE)), 2))))[v1])
#[1] "A / B" "B"     NA

Or we can use arithmetic operation to do this

c(NA, "A", "B", "A / B")[1 + df[,1] + 2 * df[,2]]
#[1] "A / B" "B"     NA

Benchmarks

Using @DavidArenburg's dataset and including the two solutions posted here (changed the column names of 'df' to 'A' and 'B')

newPaste <- function(df) {
    v1 <- do.call(paste, df)
  unname(setNames(c("A / B", "B", "A", NA), do.call(paste, 
      expand.grid(rep(list(c(TRUE, FALSE)), 2))))[v1])
}

arith <- function(df){
     c(NA, "A", "B", "A / B")[1 + df[,1] + 2 * df[,2]]
}

microbenchmark::microbenchmark(Rowwise(df), Colwise(df), newPaste(df),arith(df))
#Unit: milliseconds
#        expr        min        lq      mean     median         uq       max neval
#  Rowwise(df) 398.024791 453.68129 488.07312 481.051431 523.466771 688.36084   100
#  Colwise(df)  25.361609  28.10300  34.20972  30.952365  35.885061  95.92575   100
# newPaste(df)  65.777304  69.07432  82.08602  71.606890  82.232980 176.66516   100
#   arith(df)   1.790622   1.88339   4.74913   2.027674   4.753279  58.50942   100

Upvotes: 3

David Arenburg
David Arenburg

Reputation: 92282

I would recommend against using apply on data.frames (due to matrix conversions) and especially with a margin of 1 (row operation are slow in R). Instead, you could pretty easily vectorize this over columns without matrix conversions too, here's an example

res <- rep(NA_character_, nrow(df))
for(j in names(df)) res[df[[j]]] <- paste(res[df[[j]]], j, sep = " / ")
sub("NA / ", "", res, fixed = TRUE)
# [1] "A / B" "B"     NA

Below is a benchmark that shows about ~X16 improvement

set.seed(123)
N <- 1e5
df <- as.data.frame(matrix(sample(c(TRUE, FALSE), N*2, replace = TRUE), ncol = 2))

Rowwise <- function(df) apply(df, 1, FUN = function(x) paste(names(x)[x], collapse=" / "))

Colwise <- function(df) {
  res <- rep(NA_character_, nrow(df));
  for(j in names(df)) res[df[[j]]] <- paste(res[df[[j]]], j, sep = " / ");
  sub("NA / ", "", res, fixed = TRUE)
} 

microbenchmark::microbenchmark(Rowwise(df), Colwise(df))
# Unit: milliseconds
#        expr       min        lq      mean    median        uq      max neval cld
# Rowwise(df) 458.54526 502.43496 545.47028 548.42042 584.18000 669.6161   100   b
# Colwise(df)  27.11235  27.83873  34.65596  29.05341  32.83664 137.7905   100  a

Upvotes: 6

Related Questions