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

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 列对每个单词具有最大值，然后只保留该输入的那个 Word 的该列。对 previous question 的回应让我参与其中。此代码标识每个单词的哪个副本是最大的。

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 

Answer 1

这可以通过 summarise 来完成。使用 pivot_longer reshape 为“long”格式后，按“Input”、“Time”Word' 进行分组，然后根据条件summarise 创建“copy_value” if all 值为 0 则返回 0 或 else 返回 'copy_value' 的 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() - 无关紧要)或获取 copy_value 的 last 非零索引。现在，我们通过“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