Фильтрация с несколькими условиями на многих столбцах с использованием dplyr

Я искал SO, пытаясь найти решение безрезультатно. Так вот оно. У меня есть кадр данных со многими столбцами, некоторые из которых являются численными и должны быть неотрицательными. Я хочу очистить данные, поскольку некоторые значения в этих числовых столбцах отрицательны. Теперь я могу извлечь имена столбцов этих столбцов с регулярным выражением. Но я не уверен, как реализовать фильтрацию строк на основе этих столбцов.

Чтобы привести пример, скажем:

library(dplyr)
df <- read.table(text = 
  "id   sth1    tg1_num   sth2    tg2_num    others   
  1     dave    2         ca      35         new
  2     tom     5         tn      -3         old
  3     jane    -3        al       0         new
  4     leroy   0         az      25         old
  5     jerry   4         mi      55        old", header=TRUE)
pattern <- "_num$"
ind <- grep(pattern, colnames(df))
target_columns <- colnames(df)[ind]
df <- df %>% filter(target_columns >= 0) # it is wrong, but it what I want to do

Я хочу выйти из этой фильтрации следующим образом:

id   sth1 tg1_num   sth2 tg2_num others
1    dave       2     ca      35    new
4   leroy       0     az      25    old
5   jerry       4     mi      55    old

где строки нет. 2 и 3 отфильтровываются, потому что по меньшей мере один столбец в tg1_num и tg2_num для этих строк содержит отрицательные числа.

ОТВЕТЫ

Ответ 1

Это очень неудобное использование dplyr, но может быть верным духу

> df %>% mutate(m = do.call(pmin, select(df, ends_with("_num"))))
  id  sth1 tg1_num sth2 tg2_num others  m
1  1  dave       2   ca      35    new  2
2  2   tom       5   tn      -3    old -3
3  3  jane      -3   al       0    new -3
4  4 leroy       0   az      25    old  0
5  5 jerry       4   mi      55    old  4

Оттуда вы можете добавить filter(m >= 0), чтобы получить ответ, который вы хотите. Если бы был rowMins, аналогичный rowMeans, это значительно упростило бы это.

> rowMins <- function(df) { do.call(pmin, df) }
> df %>% mutate(m = rowMins(select(df, ends_with("_num"))))
  id  sth1 tg1_num sth2 tg2_num others  m
1  1  dave       2   ca      35    new  2
2  2   tom       5   tn      -3    old -3
3  3  jane      -3   al       0    new -3
4  4 leroy       0   az      25    old  0
5  5 jerry       4   mi      55    old  4

Я не знаю, насколько это эффективно. И вложенность select кажется настоящей уродливой.

EDIT3: Используя идеи, вырезанные из других решений/комментариев (h/t to @Vlo), я могу быстро увеличить свою скорость (к сожалению, аналогичная оптимизация ускоряет решение @Vlo еще больше (EDIT4: Упс, неверное считывание диаграммы, Я самый быстрый, хорошо, не больше на этом))

df %>% select(ends_with("_num")) %>% rowMins %>% {df[. >= 0,]}

EDIT: из любопытства, сделал некоторые микрообъективы на некоторых решениях (EDIT2: добавлено больше решений)

microbenchmark(rowmins(df), rowmins2(df), reducer(df), sapplyer(df), grepapply(df), tchotchke(df), withrowsums(df), reducer2(df))

Unit: microseconds
            expr       min         lq      mean    median        uq       max
     rowmins(df)  1373.452  1431.9700  1732.188  1576.043  1729.410  5147.847
    rowmins2(df)   836.885   875.9900  1015.364   913.285  1038.729  2510.339
     reducer(df)   990.096  1058.6645  1217.264  1201.159  1297.997  3103.809
    sapplyer(df) 14119.236 14939.8755 16820.701 15952.057 16612.709 66023.721
   grepapply(df) 12907.657 13686.2325 14517.140 14485.520 15146.294 17291.779
   tchotchke(df)  2770.818  2939.6425  3114.233  3036.926  3172.325  4098.161
 withrowsums(df)  1526.227  1627.8185  1819.220  1722.430  1876.360  3025.095
    reducer2(df)   900.524   943.1265  1087.025  1003.820  1109.188  3869.993

И вот определения, которые я использовал

rowmins <- function(df) {
  df %>%
    mutate(m = rowMins(select(df, ends_with("_num")))) %>%
    filter(m >= 0) %>%
    select(-m)
}

rowmins2 <- function(df) {
  df %>% select(ends_with("_num")) %>% rowMins %>% {df[. >= 0,]}
}

reducer <- function(df) {
  df %>%
    select(matches("_num$")) %>%
    lapply(">=", 0) %>%
    Reduce(f = "&", .) %>%
    which %>%
    slice(.data = df)
}

reducer2 <- function(df) {
  df %>%
    select(matches("_num$")) %>%
    lapply(">=", 0) %>%
    Reduce(f = "&", .) %>%
    {df[.,]}
}

sapplyer <- function(df) {
  nums <- sapply(df, is.numeric)
  df[apply(df[, nums], MARGIN=1, function(x) all(x >= 0)), ]
}

grepapply <- function(df) {
  cond <- df[, grepl("_num$", colnames(df))] >= 0
    df[apply(cond, 1, function(x) {prod(x) == 1}), ]
}

tchotchke <- function(df) {
  pattern <- "_num$"
  ind <- grep(pattern, colnames(df))
  target_columns <- colnames(df)[ind]
  desired_rows <- sapply(target_columns, function(x) which(df[,x]<0), simplify=TRUE)
  as.vector(unique(unlist(desired_rows)))
}

withrowsums <- function(df) {
  df %>% mutate(m=rowSums(select(df, ends_with("_num"))>0)) %>% filter(m==2) %>% select(-m)
}


df <- data.frame(id=1:10000, sth1=sample(LETTERS, 10000, replace=T), tg1_num=runif(10000,-1,1), tg2_num=runif(10000,-1, 1))

Ответ 2

Здесь возможное векторизованное решение

ind <- grep("_num$", colnames(df))
df[!rowSums(df[ind] < 0),]
#   id  sth1 tg1_num sth2 tg2_num others
# 1  1  dave       2   ca      35    new
# 4  4 leroy       0   az      25    old
# 5  5 jerry       4   mi      55    old

Идея здесь состоит в том, чтобы создать логическую матрицу с помощью функции < (это универсальная функция, которая имеет метод data.frame), что означает, что она возвращает структуру данных, такую ​​как структура назад). Затем мы используем rowSums, чтобы найти, были ли какие-либо согласованные условия ( > 0 - согласованы, 0 - не совпадали). Затем мы используем функцию !, чтобы преобразовать ее в логический вектор: > 0 становится TRUE, а 0 становится FALSE. Наконец, мы подмножество в соответствии с этим вектором.

Ответ 3

Я хотел видеть, что это возможно, используя стандартную оценку с dplyr filter_. Оказывается, это можно сделать с помощью interp от lazyeval, следуя пример кода на этой странице. По существу, вам нужно создать список условий interp, которые затем передаются в аргумент .dots filter_.

library(lazyeval)

dots <- lapply(target_columns, function(cols){
    interp(~y >= 0, .values = list(y = as.name(cols)))
})

filter_(df, .dots = dots)   

  id  sth1 tg1_num sth2 tg2_num others
1  1  dave       2   ca      35    new
2  4 leroy       0   az      25    old
3  5 jerry       4   mi      55    old

Update

Начиная с dplyr_0.7, это можно сделать непосредственно с помощью filter_at и all_vars (не требуется lazyeval).

df %>%
     filter_at(vars(target_columns), all_vars(. >= 0) )

  id  sth1 tg1_num sth2 tg2_num others
1  1  dave       2   ca      35    new
2  4 leroy       0   az      25    old
3  5 jerry       4   mi      55    old

Ответ 4

Использование базы R для получения результата

cond <- df[, grepl("_num$", colnames(df))] >= 0
df[apply(cond, 1, function(x) {prod(x) == 1}), ]

  id  sth1 tg1_num sth2 tg2_num others
1  1  dave       2   ca      35    new
4  4 leroy       0   az      25    old
5  5 jerry       4   mi      55    old

Изменить: это предполагает, что у вас есть несколько столбцов с "_num". Это не сработает, если у вас есть только один столбец _num

Ответ 5

Сначала мы создаем индекс всех числовых столбцов. Затем мы подмножим все столбцы, большие или равные нулю. Поэтому нет необходимости проверять имена столбцов, и идентификатор столбца всегда будет положительным.

nums <- sapply(df, is.numeric)
df[apply(df[, nums], MARGIN = 1, function(x) all(x >= 0)), ]

Вывод:

  id  sth1 tg1_num sth2 tg2_num others
1  1  dave       2   ca      35    new
4  4 leroy       0   az      25    old
5  5 jerry       4   mi      55    old

Ответ 6

Вот мое уродливое решение. Предложения/критика приветствуются

df %>% 
  # Select the columns we want
  select(matches("_num$")) %>%
  # Convert every column to logical if >= 0
  lapply(">=", 0) %>%
  # Reduce all the sublist with AND 
  Reduce(f = "&", .) %>%
  # Convert the one vector of logical into numeric
  # index since slice can't deal with logical. 
  # Can simply write `{df[.,]}` here instead,
  # which is probably faster than which + slice
  # Edit: This is not true. which + slice is faster than `[` in this case
  which %>%
  slice(.data = df)

  id  sth1 tg1_num sth2 tg2_num others
1  1  dave       2   ca      35    new
2  4 leroy       0   az      25    old
3  5 jerry       4   mi      55    old

Ответ 7

Это даст вам вектор ваших строк, который меньше 0:

desired_rows <- sapply(target_columns, function(x) which(df[,x]<0), simplify=TRUE)
desired_rows <- as.vector(unique(unlist(desired_rows)))

Затем, чтобы получить df из ваших желаемых строк:

setdiff(df, df[desired_rows,])
  id  sth1 tg1_num sth2 tg2_num others
1  1  dave       2   ca      35    new
2  4 leroy       0   az      25    old
3  5 jerry       4   mi      55    old