时间戳

首页 > 解决方案 > 根据应用于多列的规则识别要删除的行

r - 根据应用于多列的规则识别要删除的行

问题描述

如果跨多个列的内容与不同的用户条件不匹配，我想从我的数据框中删除行。

以下代表应该涵盖我想要实现的复杂性。

install.packages("dplyr")
install.packages("purrr")

options(stringsAsFactors=FALSE)

# Create user criteria (UC) data.
UC <- data.frame(
  Series = 1:5, 
  Unit = c("cm","mm",NA,NA,"cm"),
  Month = c(NA,NA,"Jan",NA,"Feb"), 
  Height = c(3,NA,NA,3,1)
)

# Create range of scenarios (RS) but only consider two series initially.
set.seed(2)
num_series <- 2
RS <- data.frame(
  Series = sample(c(1:5), num_series, replace=TRUE),
  Unit = sample(c("cm","mm"), num_series, replace=TRUE),
  Month = sample(c("Jan","Feb","Mar","Apr"), num_series, replace=TRUE), 
  Height = sample(c(1:3), num_series, replace=TRUE) 
)

# Identify applicable critera for matching (AC).
AC <- dplyr::filter(UC, UC$Series %in% unique(RS$Series)) 
AC <- AC[, !purrr::map_lgl(AC, ~all(is.na(.))), drop=FALSE]

# Combine the scenario data and the applicable criteria.
SC <- merge(x=RS, y=AC, by="Series", all.x=TRUE) 

# Function to identify rows for removal.
fn_remove_row <- function(cols, rm) {
  x <- paste0(cols,".x")
  y <- paste0(cols,".y")
  rm$remove <- ifelse(rm$remove == 0 & !is.na(rm[[y]]) & rm[[y]] != rm[[x]], 1, rm$remove)
  rm[[y]] <- NULL
  setnames(rm, eval(substitute(x)), unlist(cols))
}

# Identify columns to be considered for matching for the given scenarios.
cols <- as.list(gsub("\\.y","",grep("\\.y", names(SC), value=TRUE)))

# Final dataframe (with option to filter).
SC$remove <- 0 # Initial values.
df <- cbind(data.frame(lapply(cols, fn_remove_row, rm=SC)))
#df <- dplyr::filter(df, remove == 0)

我的代码的一些解释：

• UC 数据框提供了一些示例规则，这些规则可能适用于也可能不适用于特定列，具体取决于数据中观察到的系列。

• RS 数据帧创建了需要满足的不同数据场景，尽管我最初只考虑了两种场景。num_series可以增加该参数以提供更多场景。

• AC 数据框对用户标准进行子集化，以仅选择适用于观察到的场景的列。

• SC 数据框结合了场景数据和适用的标准。带有要应用规则的列将用.x后缀（原始数据）和.y后缀（标准）来标识。

• 我创建了一个函数来依次考虑所需的列并检查值是否匹配。如果它们不匹配，则该行将被标记为“1”以指示将其删除。如果特定列的条件值缺失 (NA)，则在这种情况下无需进行匹配。进行检查后，删除条件列，并重命名原始数据列以删除后缀。

• 我lapply用来创建包含要过滤的列的最终数据框(df)。当前未应用过滤器，因为未正确创建标志。

输入数据帧（使用种子 = 2 创建）是：

> UC                                  > RS
  Series Unit Month   Height            Series Unit Month Height
     1    cm   <NA>      3                 1    mm   Apr     1
     2    mm   <NA>     NA                 4    cm   Apr     3
     3   <NA>   Jan     NA
     4   <NA>  <NA>      3
     5    cm    Feb      1

由于 RS 包含系列 1 和 4，因此创建的 AC 也包含这些系列，并且仅包含仍然适用的列：

> AC
  Series Unit Height
     1    cm     3
     4   <NA>    3

合并根据需要组合 RS 和 AC 并remove初始化标志：

> SC
  Series Unit.x Month Height.x Unit.y Height.y remove
     1     mm    Apr      1     cm       3       0
     4     cm    Apr      3    <NA>      3       0

在这种情况下，我想将系列 1 标记为删除，因为Unit.x不等于Unit.y，但如果它们匹配，它仍然会被标记，因为Height.x不等于Height.y。月份列没有进入等式，因为这两个系列没有适用的标准。

系列 4 不会被标记，因为 Unit 比较不​​适用 ( Unit.y= NA) 并且 Height 比较给出了匹配。

最后我想要（过滤之前）：

> df
  Series Unit  Month Height remove
     1     mm    Apr     1     1
     4     cm    Apr     3     0

但是，尽管没有电话和各种未显示的尝试，但我从这些列中得到的lapply是重复的列：return()cbind

> df
  Series Unit Month Height.x Height.y remove Series.1 Unit.x Month.1 Height Unit.y remove.1
     1    mm   Apr      1      3        1       1       mm     Apr   ...

循环通过适用列的功能是否lapply错误，或者可以使其工作？对我来说，感觉就像缺少了一个微小的关键元素。

一个完整的解决方案测试应该使用不同的种子并增加num_series。

标签： rif-statementlapply

解决方案

看来这是使用for-loop而不是我们可信赖的lapply朋友的好时机：

# Function to identify rows for removal.
fn_remove_row <- function(col, rm) {
  x <- paste0(col,".x")
  y <- paste0(col,".y")
  rm$remove <- ifelse(rm$remove == 0 & !is.na(rm[[y]]) & rm[[y]] != rm[[x]], 1, rm$remove)
  rm[[y]] <- NULL
  setnames(rm, eval(substitute(x)), unlist(col))
  return(rm)
}

# Identify columns to be considered for matching for the given scenarios.
cols <- c(gsub("\\.y","",grep("\\.y", names(SC), value=TRUE)))

# Final dataframe (with option to filter).
SC$remove <- 0 # Initial values.
for (i in 1:length(cols)) {
  col <- cols[i]
  SC <- fn_remove_row(col, SC)
}

推荐阅读