Определите строки для удаления в зависимости от правил, применяемых к нескольким столбцам - PullRequest
Новая
       27

Определите строки для удаления в зависимости от правил, применяемых к нескольким столбцам

1 голос
/ 05 июля 2019

Я хотел бы удалить строки из моего фрейма данных, если содержимое нескольких столбцов не соответствует изменяющимся критериям пользователя.

Следующий репекс должен охватывать сложность того, чего я пытаюсь достичь. 

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), содержащего столбец для фильтрации.Фильтр в настоящее время не применяется, поскольку флаги не создаются правильно.

Входные кадры данных (созданные с seed = 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.y = NA) иСравнение высоты дает совпадение.

В конце я хочу (до фильтрации): 

> 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.

Ответы [ 2 ]

1 голос
/ 05 июля 2019

Вот несколько иной / векторизованный подход к этой проблеме. Я попытался прочитать это полностью и понять и, надеюсь, понял, что именно вы пытаетесь сделать. 

x <- paste0(cols,".x")
y <- paste0(cols,".y")
SC$remove <- as.integer(rowSums(!is.na(SC[y]) & SC[x] != SC[y]) > 0)
SC[y] <- NULL
names(SC)[names(SC) %in% x] <- cols

SC
#  Series Unit Month Height remove
#1      1   mm   Apr      1      1
#2      4   cm   Apr      3      0

Вы можете расширить это до многих столбцов и при необходимости обернуть в функцию.

1 голос
/ 05 июля 2019

Похоже, сейчас самое время использовать 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)
}
...