r - 根据多列的最大值减少分组数据

Question

我有像这个例子这样的数据集，但每个输入有 1000 个输入和 1000 个字，每个输入 x 时间 x 字组合有 30 个值（在 cols Copy1..Copy30 中）

df = read.table(header=T, sep=",", text="
Input,Time,Word,Copy1,Copy2,Copy3,Copy30
ark,1,ark,0.00,0.00,0.00,0.00
ark,1,ad,0.00,0.00,0.00,0.00
ark,1,bark,0.00,0.00,0.00,0.00
ark,50,ark,0.00,0.10,0.05,0.00
ark,50,ad,0.00,0.05,0.03,0.00
ark,50,bark,0.07,0.06,0.00,0.00
ark,100,ark,0.00,0.17,0.55,0.00
ark,100,ad,0.00,0.03,0.11,0.00
ark,100,bark,0.05,0.20,0.00,0.00
bark,1,ark,0.00,0.00,0.00,0.00
bark,1,ad,0.00,0.00,0.00,0.00
bark,1,bark,0.00,0.00,0.00,0.00
bark,50,ark,0.00,0.03,0.09,0.00
bark,50,ad,0.00,0.05,0.03,0.00
bark,50,bark,0.2,0.75,0.00,0.00
bark,100,ark,0.00,0.08,0.32,0.00
bark,100,ad,0.00,0.03,0.11,0.00
bark,100,bark,0.21,0.60,0.00,0.00
") %>% arrange(Input,Time,Word)

df
# Input Time Word Copy1 Copy2 Copy3 Copy30
# 1    ark    1   ad  0.00  0.00  0.00      0
# 2    ark    1  ark  0.00  0.00  0.00      0
# 3    ark    1 bark  0.00  0.00  0.00      0
# 4    ark   50   ad  0.00  0.05  0.03      0
# 5    ark   50  ark  0.00  0.10  0.05      0
# 6    ark   50 bark  0.07  0.06  0.00      0
# 7    ark  100   ad  0.00  0.03  0.11      0
# 8    ark  100  ark  0.00  0.17  0.55      0
# 9    ark  100 bark  0.05  0.20  0.00      0
# 10  bark    1   ad  0.00  0.00  0.00      0
# 11  bark    1  ark  0.00  0.00  0.00      0
# 12  bark    1 bark  0.00  0.00  0.00      0
# 13  bark   50   ad  0.00  0.05  0.03      0
# 14  bark   50  ark  0.00  0.03  0.09      0
# 15  bark   50 bark  0.20  0.75  0.00      0
# 16  bark  100   ad  0.00  0.03  0.11      0
# 17  bark  100  ark  0.00  0.08  0.32      0
# 18  bark  100 bark  0.21  0.60  0.00      0

我想按 Input 和 Word 进行分组，并且对于每个组合，确定哪个 Copy 列具有每个单词的最大值，然后只为该 Input 保留该 Word 的该列。对上一个问题的回答让我成为了其中的一部分。此代码标识每个单词的哪个副本是最大值。

max_copy <- df %>% 
  pivot_longer(starts_with("Copy"), names_to="copy_name", values_to="copy_value") %>% 
  group_by(Input, Word) %>% 
  filter(rank(copy_value, ties.method="first") == n()) %>%
  group_by(Input, Time)

max_copy
# A tibble: 6 x 5
# Groups:   Input, Time [3]
# Input  Time Word  copy_name copy_value
# <fct> <int> <fct> <chr>          <dbl>
# 1 ark     100 ad    Copy3           0.11
# 2 ark     100 ark   Copy3           0.55
# 3 ark     100 bark  Copy2           0.2 
# 4 bark     50 bark  Copy2           0.75
# 5 bark    100 ad    Copy3           0.11
# 6 bark    100 ark   Copy3           0.32

现在我想要做的是使用它来将数据减少到每个输入的每个单词的识别副本，这样结果将是：

# A tibble: 18 x 5
# Groups:   Input, Time [6]
#   Input  Time Word  copy_name copy_value
#   <fct> <int> <fct> <chr>          <dbl>
#  1 ark       1 ad    Copy3          0 
#  2 ark       1 ark   Copy3          0   
#  3 ark       1 bark  Copy2          0   
#  4 ark      50 ad    Copy3          0.03 
#  5 ark      50 ark   Copy3          0.05 
#  6 ark      50 bark  Copy2          0.06
#  7 ark     100 ad    Copy3          0.11 
#  8 ark     100 ark   Copy3          0.55
#  9 ark     100 bark  Copy2          0.2 
# 10 bark      1 ad    Copy3          0 
# 11 bark      1 ark   Copy3          0   
# 12 bark      1 bark  Copy2          0   
# 13 bark     50 ad    Copy3          0.03
# 14 bark     50 ark   Copy3          0.09
# 15 bark     50 bark  Copy2          0.75
# 16 bark    100 ad    Copy3          0.11
# 17 bark    100 ark   Copy3          0.32
# 18 bark    100 bark  Copy2          0.6 

有没有一种方法可以像这样使用 max_copy 数据来减少 df ？

编辑：下面的一些解决方案存在问题。@akrun 的解决方案如果存在负值（易于处理）或后续副本中存在正值而不是具有最大值的副本（我不知道如何解决此问题），则会中断。@AnoushiravanR 的解决方案似乎对这两种情况都很稳健，@AnilGoyal 的解决方案也是如此。这是包含这些条件的更新数据集。

df2 = read.table(header=T, sep=",", text="
Input,Time,Word,Copy1,Copy2,Copy3,Copy30
ark,1,ark,0.00,0.00,0.00,-0.01
ark,1,ad,0.00,0.00,0.00,-0.01
ark,1,bark,0.00,0.00,0.00,-0.01
ark,1,bar,0.00,0.00,0.00,-0.01
ark,50,ark,0.00,0.10,0.05,-0.01
ark,50,ad,0.00,0.05,0.03,-0.01
ark,50,bark,0.07,0.06,0.01,-0.01
ark,50,bar,0.07,0.06,0.01,-0.01
ark,100,ark,0.00,0.17,0.55,-0.01
ark,100,ad,0.00,0.03,0.11,-0.01
ark,100,bark,0.05,0.20,0.01,-0.01
ark,100,bar,0.04,0.15,0.01,-0.01
bark,1,ark,0.00,0.00,0.00,-0.01
bark,1,ad,0.00,0.00,0.00,-0.01
bark,1,bark,0.00,0.00,0.00,-0.01
bark,1,bar,0.00,0.00,0.00,-0.01
bark,50,ark,0.00,0.03,0.09,-0.01
bark,50,ad,0.00,0.05,0.03,-0.01
bark,50,bark,0.2,0.75,0.01,0.01
bark,50,bar,0.2,0.7,0.00,-0.01
bark,100,ark,0.00,0.08,0.32,-0.01
bark,100,ad,0.00,0.03,0.11,-0.01
bark,100,bark,0.21,0.60,0.01,-0.01
bark,100,bar,0.15,0.4,0.01,-0.01
") %>% arrange(Input,Time,Word)

df2 的所需输出：

# A tibble: 24 x 5
# Input  Time Word  copy_name Value
# <fct> <int> <fct> <chr>     <dbl>
# 1 ark       1 ad    Copy3      0   
# 2 ark       1 ark   Copy3      0   
# 3 ark       1 bar   Copy2      0   
# 4 ark       1 bark  Copy2      0   
# 5 ark      50 ad    Copy3      0.03
# 6 ark      50 ark   Copy3      0.05
# 7 ark      50 bar   Copy2      0.06
# 8 ark      50 bark  Copy2      0.06
# 9 ark     100 ad    Copy3      0.11
# 10 ark    100 ark   Copy3      0.55
# 11 ark    100 bar   Copy2      0.15
# 12 ark    100 bark  Copy2      0.2 
# 13 bark     1 ad    Copy3      0   
# 14 bark     1 ark   Copy3      0   
# 15 bark     1 bar   Copy2      0   
# 16 bark     1 bark  Copy2      0   
# 17 bark    50 ad    Copy3      0.03
# 18 bark    50 ark   Copy3      0.09
# 19 bark    50 bar   Copy2      0.7 
# 20 bark    50 bark  Copy2      0.75
# 21 bark   100 ad    Copy3      0.11
# 22 bark   100 ark   Copy3      0.32
# 23 bark   100 bar   Copy2      0.4 
# 24 bark   100 bark  Copy2      0.6 

标签： rdplyr

Answer 1

这可以通过summarise. 用 整形为'long'格式后pivot_longer，按'Input'，'Time' Word'进行分组，然后summarise根据if all值为0的条件创建'copy_value'，然后返回0或else返回last'的非零值复制值'

library(dplyr)
library(tidyr)
df %>% 
  pivot_longer(cols = starts_with('Copy'), names_to = 'copy_name', 
        values_to = 'copy_value') %>% 
  group_by(Input, Time, Word) %>% 
  summarise(copy_value = if(all(copy_value == 0)) 0 
       else last(copy_value[copy_value != 0]), .groups = 'drop')

-输出

# A tibble: 18 x 4
#   Input  Time Word  copy_value
# * <chr> <int> <chr>      <dbl>
# 1 ark       1 ad          0   
# 2 ark       1 ark         0   
# 3 ark       1 bark        0   
# 4 ark      50 ad          0.03
# 5 ark      50 ark         0.05
# 6 ark      50 bark        0.06
# 7 ark     100 ad          0.11
# 8 ark     100 ark         0.55
# 9 ark     100 bark        0.2 
#10 bark      1 ad          0   
#11 bark      1 ark         0   
#12 bark      1 bark        0   
#13 bark     50 ad          0.03
#14 bark     50 ark         0.09
#15 bark     50 bark        0.75
#16 bark    100 ad          0.11
#17 bark    100 ark         0.32
#18 bark    100 bark        0.6 

---

如果我们也需要'copy_name'，则使用相同的逻辑表达式slice返回满足条件的行，即if all值为0，返回最后一行（n()-无所谓）或获取lastcopy_value的非零索引. 现在，我们通过 'Input'、'Word' 和mutate'copy_name' 进行分组，将它们替换为相应的 'copy_name'，其中 'copy_value' 是max

df %>% 
  pivot_longer(cols = starts_with('Copy'), names_to = 'copy_name', 
        values_to = 'copy_value') %>% 
  group_by(Input, Time, Word) %>%
  arrange(copy_value) %>% 
  slice(if(all(copy_value <= 0)) n() 
       else tail(which(copy_value > 0), 1))%>% 
  group_by(Input, Word) %>% 
  mutate(copy_name = copy_name[which.max(copy_value)]) %>%
  ungroup

-输出

# A tibble: 18 x 5
#   Input  Time Word  copy_name copy_value
#   <chr> <int> <chr> <chr>          <dbl>
# 1 ark       1 ad    Copy3           0   
# 2 ark       1 ark   Copy3           0   
# 3 ark       1 bark  Copy2           0   
# 4 ark      50 ad    Copy3           0.03
# 5 ark      50 ark   Copy3           0.05
# 6 ark      50 bark  Copy2           0.06
# 7 ark     100 ad    Copy3           0.11
# 8 ark     100 ark   Copy3           0.55
# 9 ark     100 bark  Copy2           0.2 
#10 bark      1 ad    Copy3           0   
#11 bark      1 ark   Copy3           0   
#12 bark      1 bark  Copy2           0   
#13 bark     50 ad    Copy3           0.03
#14 bark     50 ark   Copy3           0.09
#15 bark     50 bark  Copy2           0.75
#16 bark    100 ad    Copy3           0.11
#17 bark    100 ark   Copy3           0.32
#18 bark    100 bark  Copy2           0.6