【问题标题】:Reduce grouped data based on maximum of multiple columns根据多列的最大值减少分组数据
【发布时间】:2021-07-24 19:37:31
【问题描述】:

我有类似这个例子的数据集,但每个输入有 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 的该列。对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 

【问题讨论】:

  • 我对“copy_name”有疑问,为什么前 4 行为 0 时有“Copy3”和“Copy2”。应该是 Copy30
  • 我们的想法是为每个单词根据其在整个时间序列中的最大值为 1 个输入选择 1 个副本...
  • 但是,您的 max_copy 对象在预期中没有像 0.09 这样的值

标签: r dplyr


【解决方案1】:

这可以通过summarise 完成。使用pivot_longer 整形为“long”格式后,按“Input”、“Time” Word' 进行分组,然后 summarise 根据if all 值为 0 的条件创建“copy_value”然后返回 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中使用相同的逻辑表达式返回满足条件的行即ifall值为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 
 

【讨论】:

  • @akrun 这非常接近但不完全。这个想法是,对于每个 Input x Word 组合,我们将选择一个副本并在每次保留该副本,即使值为 0。您的解决方案在 Time = 1 时为所有单词选择 Copy30,但它应该是相同的 CopyXs与其他时间步骤一样。有什么想法吗?
  • @user20412 我猜更新后的输出与您的预期匹配。请检查
  • 太漂亮了,谢谢。我将不得不研究它才能理解,但我非常感激!
  • 亲爱的@akrun 我终于做了一些修改以获得所需的输出。感谢大家的支持和鼓励。
  • @user20412 所有回答者都根据您的初始数据发布了解决方案。通过更改输入,这有点像在这里创建一个新问题
【解决方案2】:

更新的解决方案

我已使用您的新数据集更新了我的解决方案。我看不出输出有什么问题,但如果有任何需要修改的地方,我很乐意知道。

library(dplyr)
library(tidyr)
library(purrr)


df2 %>%
  mutate(Copy_value = pmap_dbl(df2 %>% select(Copy1:Copy30), ~ max(c(...))),
         Copy_name = pmap(df2 %>% select(Copy1:Copy30), ~ 
                            names(c(...)[c(...) == max(c(...))]))) %>%
  unnest(Copy_name) %>% 
  group_by(Input, Word) %>%
  mutate(Copy_name = Copy_name[which.max(Copy_value)]) %>%
  distinct() %>%
  select(-c(Copy1:Copy_value)) %>%
  right_join(df2, by = c("Input", "Time", "Word")) %>%
  rowwise() %>%
  mutate(Copy_value = map_dbl(Copy_name, ~ get({.x}))) %>%
  select(-c(Copy1:Copy30))

输出 这是新提供的数据集的输出。

   Input Time Word Copy_name Copy_value
1    ark    1   ad     Copy3       0.00
2    ark    1  ark     Copy3       0.00
3    ark    1  bar     Copy2       0.00
4    ark    1 bark     Copy2       0.00
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.20
13  bark    1   ad     Copy3       0.00
14  bark    1  ark     Copy3       0.00
15  bark    1  bar     Copy2       0.00
16  bark    1 bark     Copy2       0.00
17  bark   50   ad     Copy3       0.03
18  bark   50  ark     Copy3       0.09
19  bark   50  bar     Copy2       0.70
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.40
24  bark  100 bark     Copy2       0.60

【讨论】:

  • 太棒了!谢谢你。我试图通过这些步骤来理解它是如何工作的。似乎我无法将它扩展到我的实际数据,因为内存需求太大(它在我的 linux 机器上崩溃了 R,而 pivot_longer 解决方案可以快速处理巨大的实际数据集而没有内存问题)。我正在尝试查看是否可以确定导致主内存问题的步骤。
  • 欢迎您。毫无疑问,在这种情况下,旋转总是比使用 pmap 更快。我已经在各种问题上对它们进行了基准测试,并看到了相当大的差异,但在这里我想使用一种稳定且更有可能产生所需输出的解决方案。但是你遇到这样的问题很奇怪。我认为前两行是最昂贵的,可能会减慢代码速度。但如果您想处理庞大的数据集,data.table 包解决方案可能是最佳选择。
【解决方案3】:

通过purrr 的另一种方法

df %>% 
  pivot_longer(cols = starts_with('Copy'), names_to = 'copy_name', 
               values_to = 'Value') %>%
  semi_join(df %>% nest(copy_name = !c(Input, Word)) %>%
              mutate(copy_name = map_chr(copy_name, 
                                    ~ names(.x)[1 + which(.x[-1] == max(.x[-1]), arr.ind = T)[2]])),
            by = c("Input", "Word", "copy_name")
            )

# A tibble: 18 x 5
   Input  Time Word  copy_name 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

其实这个cn可以分成两部分-

  • 首先是通过嵌套和purrr::map_chr,其中找到那些副本的名称,其中副本值对于任何时间值都是最大值。
df %>% nest(copy_name = !c(Input, Word)) %>%
              mutate(copy_name = map_chr(copy_name, 
                                    ~ names(.x)[1 + which(.x[-1] == max(.x[-1]), arr.ind = T)[2]]))

# A tibble: 6 x 3
  Input Word  copy_name
  <chr> <chr> <chr>    
1 ark   ad    Copy3    
2 ark   ark   Copy3    
3 ark   bark  Copy2    
4 bark  ad    Copy3    
5 bark  ark   Copy3    
6 bark  bark  Copy2
  • 第二部分是通过semi_join 将透视数据与此数据重新连接起来,这实际上是一个过滤连接。

单管中的另一种方法

df %>% nest(data = !c(Input, Word)) %>%
  mutate(data = map(data, ~ .x %>% 
                      select(Time, 1+which(.x[-1] == max(.x[-1]), arr.ind = T)[2]) %>%
                      mutate(copy = names(.)[2]) %>%
                      rename_with(~'value', 2)
                    )) %>%
  unnest(data)

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

【讨论】:

  • 这些都是很好的解决方案。但是,如果最大值之间存在联系,它们似乎会中断。例如,如果您将树皮在时间 100 的 Copy2 的值​​更改为 0.75(与时间 50 相同),它将选择 Copy3。使用我的完整数据集,我发现当有关系时它不会为单词选择任何副本。有什么建议吗,@AnilGoyal?
猜你喜欢
  • 1970-01-01
  • 2019-04-02
  • 1970-01-01
  • 2012-12-09
  • 1970-01-01
  • 2021-07-19
  • 2018-10-18
  • 2020-11-10
  • 2020-01-12
相关资源
最近更新 更多