使用dplyr在许多列上过滤多个条件

bre*_*mri 12 r

我搜索过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's is wrong, but it's what I want to do
Run Code Online (Sandbox Code Playgroud)

我想从这个过滤中获得的是以下内容:

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
Run Code Online (Sandbox Code Playgroud)

行没有.滤除了2和3,因为这些行的tg1_num和tg2_num中的至少一列包含负数.

Dav*_*urg 6

这是一个可能的矢量化解决方案

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
Run Code Online (Sandbox Code Playgroud)

这里的想法是使用<函数创建一个逻辑矩阵(它是一个具有data.frame方法的通用函数- 这意味着它返回一个像结构一样的数据框).然后,我们rowSums用来查找是否存在任何匹配的条件(> 0 - 匹配,0-不匹配).然后,我们使用该!函数将其转换为逻辑向量:> 0变为TRUE,而0变为FALSE.最后,我们根据该向量进行子集化.


use*_*691 4

这是一种非常尴尬的用法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
Run Code Online (Sandbox Code Playgroud)

从那里您可以添加 afilter(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
Run Code Online (Sandbox Code Playgroud)

但我不知道这有多有效。而且嵌套select看起来真的很难看。

编辑3:使用从其他解决方案/评论(h / t到@Vlo)抄袭的想法,我可以加快我的速度很多(不幸的是,类似的优化加快了@Vlo的解决方案的速度(编辑4:哎呀,误读了图表,我是最快,好的,不再赘述))

df %>% select(ends_with("_num")) %>% rowMins %>% {df[. >= 0,]}
Run Code Online (Sandbox Code Playgroud)

编辑:出于好奇,对某些解决方案进行了一些微基准测试(编辑2:添加了更多解决方案)

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
Run Code Online (Sandbox Code Playgroud)

这是我使用的定义

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))
Run Code Online (Sandbox Code Playgroud)