dplyr мутировать на основе столбцов в векторе

Question

Допустим, у меня есть кадр данных, который выглядит следующим образом:

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

Я хочу создать новый столбец, который реализует следующую логику: Если все значения в столбцах указаны в mycolsравно -1, затем TRUE, иначе FALSE.Итак, если я установлю mycols <- c("R2", "R3", "R99"), то результат будет

somefeature
      FALSE
       TRUE

С другой стороны, если я установлю mycols <- c("R1", "R2"), то результат будет

somefeature
       TRUE
      FALSE

Какэто можно сделать для общего mycols?Я бы предпочел решение с использованием dplyr.Кроме того, я хочу иметь возможность сохранять все столбцы после операции.

---

ОБНОВЛЕНИЕ: Чтобы решить, какое решение принять, я решил сравнить производительность всех методов:

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

Решение Base R является самым быстрым.Однако я указал, что хочу использовать tidyverse, поэтому я решил принять решение, которое обеспечило самое быстрое решение на основе tidyverse.

Answer 1

Вот вариант с tidyverse.Создать функцию для повторного использования.С помощью цикла map (из purrr) над подмножеством столбцов, указанных в 'nameVec', создайте list логических векторов, reduce его в один вектор, взяв сумму и проверив, равно ли онаlength of 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))

Answer 2

Быстрое базовое решение R с использованием rowSums

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

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

это также можно записать как

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

---

Однако, если вы предпочитаете dplyr один подход с использованиемrowwise и do будут

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