R 根据最多多列减少分组数据
我有像这个例子一样的数据集，但每个输入有1000个输入和1000个字，每个输入x时间x字组合有30个值（在cols Copy1..Copy30中） 我想按输入和单词进行分组，对于每个组合，确定哪个复制列对每个单词具有最大值，然后仅为该输入的单词保留该列。对一封信的回复让我走到了那里。此代码标识每个单词的最大副本R 根据最多多列减少分组数据,r,dplyr,R,Dplyr,我有像这个例子一样的数据集，但每个输入有1000个输入和1000个字，每个输入x时间x字组合有30个值（在cols Copy1..Copy30中） 我想按输入和单词进行分组，对于每个组合，确定哪个复制列对每个单词具有最大值，然后仅为该输入的单词保留该列。对一封信的回复让我走到了那里。此代码标识每个单词的最大副本 max_copy <- df %>% pivot_longer(starts_with("Copy"), names_to="copy_n
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: 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
#一个tible:24 x 5
#输入时间字复制\u名称值
#
#1方舟1广告副本3 0
#2方舟1方舟副本3 0
#3方格1条复印件2 0
#4方舟1树皮2 0
#5方舟50广告副本3 0.03
#6方舟50方舟副本3 0.05
#7方舟50条复印件2 0.06
#8方舟50树皮2 0.06
#9方舟100广告副本3 0.11
#10方舟100方舟复制3 0.55
#11方舟100条复印件2 0.15
#12方舟100树皮2 0.2
#13树皮1广告文案3 0
#14树皮1方舟Copy3 0
#15树皮1条复印件2 0
#16树皮1树皮副本2 0
#17树皮50广告文案30.03
#18树皮50方格纸30.09
#19树皮50条拷贝2 0.7
#20树皮50树皮2 0.75
#21树皮100广告文案3 0.11
#22树皮100方格纸30.32
#23树皮100条拷贝2 0.4
#24树皮100树皮2 0.6
摘要来完成。在使用pivot\u long
重新格式化为“long”格式后，按“Input”、“Time”单词进行分组，然后总结
创建“copy\u value”，条件是如果所有值均为0，则返回0或否则返回最后一个非零值的“copy\u value”
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
# 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
-输出
# 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
# 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
#一个tible:18x5
#输入时间字复制\名称复制\值
#
#1方舟1广告副本3 0
#2方舟1方舟副本3 0
#3方舟1树皮2 0
#4方舟50广告副本3 0.03
#5方舟50方舟副本3 0.05
#6方舟50树皮2 0.06
#7方舟100广告副本3 0.11
#8方舟100方舟复制3 0.55
#9方舟100树皮2 0.2
#10树皮1广告文案3 0
#11树皮1方舟Copy3 0
#12树皮1树皮副本2 0
#13树皮50广告文案30.03
#14树皮50方格纸30.09
#15树皮50树皮2 0.75
#16树皮100广告文案3 0.11
#17树皮100方格纸30.32
#18树皮100树皮2 0.6
更新的解决方案
我已使用您的新数据集更新了我的解决方案。我看不出输出有什么问题，但如果有什么需要修改的地方，我很乐意知道
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
通过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
- 第二部分通过
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
df%>%nest（数据=！c（输入，字））%>%
变异（数据=映射（数据，~.x%>%
选择（时间，1+which（.x[-1]==max（.x[-1]），arr.ind=T）[2]）%>%
变异（拷贝=名称（.）[2]）%>%
用（~'value'，2）重命名\u
)) %>%
unnest（数据）
#一个tibble:18x5
输入字时间值拷贝
1方舟广告10副本3
2方舟广告50 0.03副本3
3方舟广告100 0.11副本3
4方舟1 0副本3
5方舟50 0.05副本3
6方舟100 0.55副本3
7方舟树皮1 0副本2
8方舟树皮50 0.06 Copy2
9方舟树皮100 0.2份2
10树皮广告10副本3
11树皮广告50 0.03副本3
12树皮广告100 0.11副本3
13树皮方舟1 0副本3
14树皮方舟50 0.09 Copy3
15树皮方舟100 0.32 Copy3
16树皮1 0拷贝2
17树皮50 0.75 Copy2
18树皮100 0.6 Copy2
我对“copy\u name”有疑问，为什么在前4行为0时有“Copy3”、“Copy2”。如果是copy30，则根据每个单词在整个时间序列中的最大值，为每个单词选择一个副本，用于1个输入…但是，您的max\u copy
对象在expected@akrun这是非常接近，但不完全。其思想是，对于每个输入x字组合，我们将选择一个副本，并在每次保留该副本，即使该值为0。您的解决方案在Time=1时为所有单词选择Copy30，但它应该与其他时间步骤中的copyx相同。有什么想法吗？@user20412我想更新后的输出符合您的预期。请检查一下，很漂亮，谢谢。我必须学习它才能理解，但我非常感激！亲爱的@akrun，我最终做了一些修改，以获得所需的输出。感谢您的支持和鼓励。@user20412所有回答者都根据您的初始数据发布了解决方案。通过改变输入，这就产生了一个新的问题，这些都是简洁的解决方案。但是，如果在最大值中存在联系，它们似乎会中断。例如，如果在时间100时将树皮的Copy2值更改为0.75（与时间50时相同），则会选择Copy3。在我的完整数据集中，我发现当有关系时，它不会为一个单词选择任何副本。有什么建议吗，@AnilGoyal？太好了！非常感谢。我试图通过这些步骤来理解它是如何工作的。我似乎无法将它扩展到我的实际数据，因为内存需求太大了（它在我的linux机器上崩溃了，而pivot_longer解决方案可以处理大量的数据）
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
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
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