我搜索过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中的至少一列包含负数.
这是一个可能的矢量化解决方案
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.最后,我们根据该向量进行子集化.
这是一种非常尴尬的用法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)