Распознавание строк, разделенных запятыми, как дубликатов
У меня есть этот набор данных, который выглядит в R следующим образом:
sample_table = data.frame( colors = c("red", "blue", "red,blue", "blue, red"), counts = c(12, 10, 5,6))
colors counts
1 red 12
2 blue 10
3 red,blue 5
4 blue, red 6
Я хочу признать, что «синий, красный» и «красный, синий» — это одно и то же, и суммировать оба значения в одну строку:
colors counts
1 red 12
2 blue 10
3 red,blue 11
Есть ли стандартный способ сделать это в R (например, для нескольких цветов, например «красный, синий, зеленый» = «зеленый, синий, красный»)
Я сделал это вручную:
standardize_colors <- function(color_string) {
colors <- unlist(strsplit(color_string, ",\\s*"))
return(paste(sort(colors), collapse = ","))
}
sample_table$standardized_colors <- sapply(sample_table$colors, standardize_colors)
aggregated_table <- aggregate(counts ~ standardized_colors, data = sample_table, sum)
print(aggregated_table)
Есть ли более эффективный способ сделать это?
Ответы 3
Один подход с {dplyr}:
library(dplyr)
sample_table |>
mutate(colors = gsub('\\s*', '', colors) |>
strsplit(',') |>
lapply(sort)
) |>
summarise(counts = sum(counts), .by = colors)
Обратите внимание, что ваш вариант с базой R, хотя и менее краток, явно более эффективен с точки зрения скорости (примерно в два раза быстрее).
sample_table %>% mutate(colors = gsub('\\s*', '',colors) %>% strsplit(',') %>% lapply(sort) ) %>% summarise(counts = sum(counts) , .by = цвета)
|> — оператор канала в базе R. Он был введен после оператора канала %>% из «tidyverse». Вы можете использовать любой из них.
В базе R вы можете использовать базовый strsplit-rbind-подход, например
sample_table = data.frame(
colors = c("red", "blue", "red,blue", "blue, red"), counts = c(12, 10, 5,6))
o = do.call("rbind",
lapply(l<-strsplit(sample_table$colors, ","), `length<-`, max(lengths(l))))
sample_table =
cbind.data.frame(o, sample_table$counts) |>
setNames(c(paste0("col", seq(ncol(o))), "counts"))
а затем адаптируйте эту прекрасную идею от пользователя Onyambu в соответствии с вашими потребностями, например
f = \(X) {
# if (nrow(X)==1L) X else
rbind(X[1L:2L,], f(X[!tapply(unlist(X[-3L]) %in% X[1L,], row(X[-3L]), sum), ]))
}
f(sample_table)
#> col1 col2 counts
#> 1 red <NA> 12
#> 2 blue <NA> 10
#> 4 blue red 6
Редактировать:
Небольшие изменения в вашем подходе:
sample_table = data.frame(
colors = c("red", "blue", "red,blue", "blue, red"), counts = c(12, 10, 5,6))
sample_table$colors = vapply(sample_table$colors,
\(x) strsplit((x), ",\\s*")
|> unlist() |> sort() |> toString() , character(1L))
aggregate(counts ~ colors, data = sample_table, sum)
Где вы ожидаете свое бутылочное горлышко?
Это базовое решение R лишь немного отличается от решения в вопросе
но он немного короче и все находится в одном конвейере. Он исключает standarize_colors и unlist и заменяет paste более коротким toString.
sample_table |>
transform(colors = sapply(strsplit(colors, ",\\s*"), \(x) toString(sort(x)))) |>
aggregate(counts ~ colors, data = _, sum)
предоставление
colors counts
1 blue 10
2 blue, red 11
3 red 12
Спасибо! Это старый формат?