在某些条件下随机选择R中的行

Question

来自原始样本数据集：

id <- c('1','1','2', '2', '3', '3', '3')
month <- c('6', '6', '3', '3', '4', '4', '4')
iso <- c('MEX', 'USA', 'CRI', 'SPA', 'CHN', 'MEX', 'SPA')
value <- c('1550', '1550', '384', '115', '1100', '1100', '1100')
original <- data.frame(id, month, iso, value)

我希望每个 id-month 对只得到 1 次观察。 遵循的规则是：

1. 为每个 id-month 对选择最大值值。
2. 如果同一 id-month 对的不同观察值存在 相同 最大值，我想随机选择其中一行。

因此，新示例数据集将如下所示：

id <- c('1', '2', '3')
month <- c('6', '3', '4')
iso <- c('USA', 'CRI','MEX')
value <- c('1550', '384', '1100')
selection_criteria <- c('random','max_value','random')
new <- data.frame(id, month, iso, value, selection_criteria)

我已尝试运行以下代码：

new <- original %>% group_by(id, month) %>%
  filter(value == max(value))

但是，当我有多个具有最大值的观察值（对于相同的 id-month 对）时，随机选择一个变量并不能成为窍门。

鉴于我的数据集的维度很大，我的意图是自动化该过程。

有什么线索吗？

谢谢。

Answer 1

试试这个

set.seed(2021)

new <- original %>% group_by(id, month) %>%
  slice_max(as.numeric(value)) %>% sample_n(1)

> new
# A tibble: 3 x 4
# Groups:   id, month [3]
  id    month iso   value
  <chr> <chr> <chr> <chr>
1 1     6     MEX   1550 
2 2     3     CRI   384  
3 3     4     MEX   1100

slice_max 将导致过滤每个组中的所有最大值行。进一步的 sample_n(size =1) 将再次限制每组中的一行

Answer 2

两件事：

1. which.max 是匹配最大值的更规范的方式，而不是val == max(val)；虽然此数据不太可能，但如果您的数据在小数范围内存在差异，则浮点相等可能是一个问题（c.f.、Why are these numbers not equal?、Is floating point math broken? 和 https://en.wikipedia.org/wiki/IEEE_754）；我将完全推荐一种不同的方法...

2. rank 会告诉您哪些值是最高/最低的，并且查找排名 1 非常简单。在存在平局的情况下，它有几个选项，其中一个是 "random"。

   rank(c(1,1), ties = "first")
   # [1] 1 2
   rank(c(1,1), ties = "last")
   # [1] 2 1
   rank(c(1,1), ties = "average")
   # [1] 1.5 1.5
   rank(c(1,1), ties = "random")
   # [1] 1 2
   rank(c(1,1), ties = "random")
   # [1] 2 1
   

3. 您正在寻找一个字符串的max，它并不总是返回字符串中的最大数值。例如，max(c("9", "11")) 返回"9"，因为它使用字典排序。如果您想要最大 numeric 值，那么我们需要（至少暂时）转换为数字。如果您的意图确实是按字母顺序排序，并且您希望 9 大于 11，则删除 as.numeric。

set.seed(2020)
original %>%
  group_by(id, month) %>%
  filter(rank(as.numeric(value), ties = "random") == 1L)
# # A tibble: 3 x 4
# # Groups:   id, month [3]
#   id    month iso   value
#   <chr> <chr> <chr> <chr>
# 1 1     6     USA   1550 
# 2 2     3     SPA   115  
# 3 3     4     MEX   1100 

set.seed(2021)
original %>%
  group_by(id, month) %>%
  filter(rank(as.numeric(value), ties = "random") == 1L)
# # A tibble: 3 x 4
# # Groups:   id, month [3]
#   id    month iso   value
#   <chr> <chr> <chr> <chr>
# 1 1     6     MEX   1550 
# 2 2     3     SPA   115  
# 3 3     4     CHN   1100 

---

旁注

@AnilGoyal 的回答建议使用slice_max 和sample_n 更符合dplyr-惯用的解决方案。如果您更喜欢在 tidyverse 中使用更具声明性的动词，那么也许这是一个不错的选择（因为可读性和可维护性很重要）。

您的数据并不表明您在大型数据集中执行此操作，在这种情况下，基准测试并不重要。如果我不正确，并且您确实需要关注性能，那么 dplyr-only 解决方案会慢一些。

# pre-group the data so that that isn't in the benchmark comparison;
# also, `as.numeric` is used in both, do that ahead of time
original_grouped <- mutate(original, value_num = as.numeric(value)) %>%
  group_by(id, month)

bench::mark(
  base = filter(original_grouped, rank(value_num, ties = "random") == 1L),
  dplyr = sample_n(slice_max(original_grouped, value_num), 1),
  check = FALSE)
# # A tibble: 2 x 13
#   expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory                  time           gc                
#   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>                  <list>         <list>            
# 1 base         1.07ms   1.16ms      815.    9.34KB     4.18   390     2      478ms <NULL> <Rprofmem[,3] [8 x 3]>  <bch:tm [392]> <tibble [392 x 3]>
# 2 dplyr        2.25ms   2.45ms      378.   10.66KB     6.44   176     3      466ms <NULL> <Rprofmem[,3] [11 x 3]> <bch:tm [179]> <tibble [179 x 3]>

虽然随着数据量的增加，这种优势会减弱：

original_big <- bind_rows(replicate(10000, original, simplify = FALSE))
original_big_grouped <- mutate(original_big, value_num = as.numeric(value)) %>%
  group_by(id, month)
bench::mark(base = filter(original_big_grouped, rank(value_num, ties = "random") == 1L), dplyr = sample_n(slice_max(original_big_grouped, value_num), 1), check = FALSE)
# # A tibble: 2 x 13
#   expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory                   time          gc               
#   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>                   <list>        <list>           
# 1 base          6.9ms   7.47ms      128.    4.82MB     16.0    48     6      375ms <NULL> <Rprofmem[,3] [50 x 3]>  <bch:tm [54]> <tibble [54 x 3]>
# 2 dplyr        7.61ms   8.23ms      119.   11.65MB     71.1    25    15      211ms <NULL> <Rprofmem[,3] [106 x 3]> <bch:tm [40]> <tibble [40 x 3]>

Answer 3

使用data.table

library(data.table)
setDT(original)[, .SD[which.max(value)], .(id, month)]