2
votes

Let's say I have a dataframe that looks like this:

R1 R2 R3 ... R99 R100
-1 -1  2 ...   3   57
45 -1 -1 ...  -1   37

I want to be create a new column which implements the following logic: If all of the values across the columns specified in mycols equal -1, then TRUE, else FALSE. So, if I set mycols <- c("R2", "R3", "R99"), then the result would be

somefeature
      FALSE
       TRUE

On the other hand, if I set mycols <- c("R1", "R2"), then the result would be

somefeature
       TRUE
      FALSE

How can this be done for general mycols? I would prefer a solution using dplyr. Also, I want to be able to keep all the columns after the operation.


UPDATE: To decide which solution to accept, I decided to compare the performance of all the methods:

library(tidyverse)
library(purrr)
library(microbenchmark)

set.seed(42)
n <- 1e4
p <- 100
x <- runif(n*p); x[x < 0.8] <- -1
col_no <- paste0("R", rep(seq(1, p), n))
id <- rep(1:n, each = p)
df <- data.frame(id, x, col_no) 
df <- df %>% spread(col_no, x)

foo <- function(df, mycols) {
  bind_cols(df, somefeature = df %>%
                              select(mycols) %>%
                              rowwise() %>%
                              do( (.) %>% as.data.frame %>% 
                              mutate(temp = all(. == -1))) %>%
                              pull(temp))
}

bar <- function(df, mycols) {
  df$somefeature = rowSums(df[mycols] != -1) == 0
  df
}

baz <- function(df, mycols) {
  df %>%
  mutate(somefeature = map(.[mycols], `==`, -1) %>% 
                       reduce(`+`) %>%
                       {. == length(mycols) })
}

mycols <- paste0("R", c(1:50))
res1 <- foo(df, mycols)  # Takes roughly a minute on my machine
res2 <- bar(df, mycols)
res3 <- baz(df, mycols)

# Verify all methods give the same solution
stopifnot(ncol(res1) == ncol(res2))
stopifnot(ncol(res1) == ncol(res3))
stopifnot(all(res1$somefeature == res2$somefeature))
stopifnot(all(res1$somefeature == res3$somefeature))

# Time the methods (not foo, as it is much slower than the other two)
microbenchmark(bar(df, mycols), baz(df, mycols))

Unit: milliseconds
            expr      min       lq      mean    median        uq      max neval
 bar(df, mycols) 3.926076 5.534273  6.782348  6.468424  7.019863 30.70699   100
 baz(df, mycols) 8.289160 9.598482 11.726803 10.208659 10.909052 72.72334   100

The base R solution is the fastest. However, I did specify that I wanted to use tidyverse, hence I decided to accept the solution that provided the fastest tidyverse-based solution.

2

2 Answers

1
votes

Here is an option with tidyverse. Create a function for repeated usage. With map (from purrr) loop over the subset of columns specified in 'nameVec', create a list of logical vectors, reduce it to single vector by taking the sum and check if it is equal to the length of the 'nameVec'

library(tidyverse)
mycols <- c("R2", "R3", "R99")
f1 <- function(dat, nameVec){
 dat %>%
    mutate(somefeature = map(.[nameVec], `==`, -1) %>% 
                                  reduce(`+`) %>%
                      {. == length(nameVec) })

 }


f1(df1, mycols)
#   R1 R2 R3 R99 R100 somefeature
#1 -1 -1  2   3   57       FALSE
#2 45 -1 -1  -1   37        TRUE

mycols <- c("R1", "R2")
f1(df1, mycols)
#    R1 R2 R3 R99 R100 somefeature
#1 -1 -1  2   3   57        TRUE
#2 45 -1 -1  -1   37       FALSE

data

df1 <- structure(list(R1 = c(-1L, 45L), R2 = c(-1L, -1L), R3 = c(2L, 
 -1L), R99 = c(3L, -1L), R100 = c(57L, 37L)), class = "data.frame", 
 row.names = c(NA, -2L))
2
votes

A quick base R solution using rowSums

mycols <- c("R2", "R3", "R99")

rowSums(df[mycols] != -1) == 0
#[1] FALSE  TRUE

this can also be written as

rowSums(df[mycols] == -1) == length(mycols)
#[1] FALSE  TRUE

However, if you prefer dplyr one approach using rowwise and do would be

library(dplyr)


bind_cols(df, somefeature = df %>%
                             select(mycols) %>%
                             rowwise() %>%
                             do( (.) %>% as.data.frame %>% 
                             mutate(temp = all(. == -1))) %>%
                             pull(temp))


#  R1 R2 R3 R99 R100 somefeature
#1 -1 21  2   3   57       FALSE
#2 45 -1 -1  -1   37        TRUE