logo标签列表

统计某个值出现的次数，并将结果添加到一列中。

rdataframedata.table
8

我有这个数据框：

   Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
1:          1 0 0 0 0 0 0   4   4   4   4   5   5
2:          2 0 0 0 0 0 0   4   4   4   4   4   4
3:          3 0 0 0 0 0 0   5   5   5   5   5   5
4:          4 0 0 0 0 0 0   4   5   5   5   4   4
5:          5 0 0 0 0 0 0   5   4   4   4   4   4
6:          6 0 0 0 0 0 0   5   5   5   5   4   4

我想修改列 1 到 6，使每列计算右侧列 (NP1 - NP6) 中该值出现的次数。也就是说，4 列应该计算 4 出现的次数。我希望对每个数字都重复这个过程。这个数字可以取值在 0 到 5 之间。最终结果应该像这样:

head(t2 %>% select(1, 2, 3, 4, 5, 6, 7, NP1, NP2, NP3, NP4, NP5, NP6))
   Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
1:          1 0 0 0 4 2 0   4   4   4   4   5   5
2:          2 0 0 0 6 0 0   4   4   4   4   4   4
3:          3 0 0 0 0 6 0   5   5   5   5   5   5
4:          4 0 0 0 3 3 0   4   5   5   5   4   4
5:          5 0 0 0 5 1 0   5   4   4   4   4   4
6:          6 0 0 0 2 4 0   5   5   5   5   4   4

我尝试使用包data.table，我已经执行了以下操作:

 t2[NP1 == 4]$`4` <- t2[NP1 == 4]$`4` + 1

但是我遇到了以下错误:

在[<-.data.table(* tmp *, NP1 == 4, value = c(1, 1, 1, 1))中出错： 无法在同一查询中两次分配相同的列（检测到重复项）。

因此我有两个问题：

  • 为什么会出现这个错误？
  • 是否有更简单、更直观的方法来完成它？
4个回答
8

使用 data.table：

library(data.table)

setDT(t2)

t2[,as.character(1:6):=lapply(1:6, function(n) rowSums(.SD==n)),.SDcols=NP1:NP6][]

#   Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
#1:          1 0 0 0 4 2 0   4   4   4   4   5   5
#2:          2 0 0 0 6 0 0   4   4   4   4   4   4
#3:          3 0 0 0 0 6 0   5   5   5   5   5   5
#4:          4 0 0 0 3 3 0   4   5   5   5   4   4
#5:          5 0 0 0 5 1 0   5   4   4   4   4   4
#6:          6 0 0 0 2 4 0   5   5   5   5   4   4

数据：

t2 <- read.table(text=
"Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
          1 0 0 0 0 0 0   4   4   4   4   5   5
          2 0 0 0 0 0 0   4   4   4   4   4   4
          3 0 0 0 0 0 0   5   5   5   5   5   5
          4 0 0 0 0 0 0   4   5   5   5   4   4
          5 0 0 0 0 0 0   5   4   4   4   4   4
          6 0 0 0 0 0 0   5   5   5   5   4   4",header=T)

colnames(t2) <- c('Generacion','1','2','3','4','5','6','NP1','NP2','NP3','NP4','NP5','NP6')
3
使用t2[,as.character(1:6):=lapply(1:6, function(n) rowSums(.SD==n)), .SDcols=patterns("^NP")]更符合data.table的规范。(尽管基准测试差异很小，但证明使用.SD和.SDcols略微比使用.SD[...]更快。) - r2evans
1
@r2evans，感谢您的建议，这确实对性能有影响。我已经更新了我的回答！ - Waldi
唯一脆弱的部分是将 as.character(1:6) 与 patterns("^NP") 程序化 同步。我猜更好的方法是在 lapply 之前确定两组名称，也许是 nms <- gsub("NP", "", grep("^NP", colnames(t2), value=TRUE)) 然后 t2[, (nms) := lapply(nms, function(n) rowSums(.SD==n)), .SDcols=paste0("NP", nms)]。 - r2evans
5

dplyr提供的一种选择是（使用已更正的列名导入数据）：

df %>%
    mutate(across(X1:X6, ~ rowSums(across(NP1:NP6) == as.numeric(sub("\\D+", "", cur_column())))))

   Generacion X1 X2 X3 X4 X5 X6 NP1 NP2 NP3 NP4 NP5 NP6
1:          1  0  0  0  4  2  0   4   4   4   4   5   5
2:          2  0  0  0  6  0  0   4   4   4   4   4   4
3:          3  0  0  0  0  6  0   5   5   5   5   5   5
4:          4  0  0  0  3  3  0   4   5   5   5   4   4
5:          5  0  0  0  5  1  0   5   4   4   4   4   4
6:          6  0  0  0  2  4  0   5   5   5   5   4   4

如果您想使用仅包含数字的列名：

df %>%
    mutate(across(`1`:`6`, ~ rowSums(across(NP1:NP6) == as.numeric(cur_column()))))

 Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
1          1 0 0 0 4 2 0   4   4   4   4   5   5
2          2 0 0 0 6 0 0   4   4   4   4   4   4
3          3 0 0 0 0 6 0   5   5   5   5   5   5
4          4 0 0 0 3 3 0   4   5   5   5   4   4
5          5 0 0 0 5 1 0   5   4   4   4   4   4
6          6 0 0 0 2 4 0   5   5   5   5   4   4
4
首先，获取必须等于整数的列和相应以这些整数为名称的列。
此代码部分适用于以下两个解决方案。
cols_to_add <- grep("^NP", names(t2), value = TRUE)
cols_to_change <- match(gsub("[^[:digit:]]", "", cols_to_add), names(t2)[-1])

基础R

在我看来，最简单的方法是使用基础R函数rowSums。

t2[as.character(cols_to_change)] <- lapply(cols_to_change, \(x) rowSums(t2[cols_to_add] == x))
t2
#  Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
#1          1 0 0 0 4 2 0   4   4   4   4   5   5
#2          2 0 0 0 6 0 0   4   4   4   4   4   4
#3          3 0 0 0 0 6 0   5   5   5   5   5   5
#4          4 0 0 0 3 3 0   4   5   5   5   4   4
#5          5 0 0 0 5 1 0   5   4   4   4   4   4
#6          6 0 0 0 2 4 0   5   5   5   5   4   4

data.table 包

下面是一个使用 data.table 的解决方案，同样使用了 lapply 循环。

library(data.table)

setDT(t2)
t2[, as.character(cols_to_change) := lapply(
  cols_to_change, \(x) rowSums(.SD == x)), 
  .SDcols = cols_to_add]
t2
#   Generacion 1 2 3 4 5 6 NP1 NP2 NP3 NP4 NP5 NP6
#1:          1 0 0 0 4 2 0   4   4   4   4   5   5
#2:          2 0 0 0 6 0 0   4   4   4   4   4   4
#3:          3 0 0 0 0 6 0   5   5   5   5   5   5
#4:          4 0 0 0 3 3 0   4   5   5   5   4   4
#5:          5 0 0 0 5 1 0   5   4   4   4   4   4
#6:          6 0 0 0 2 4 0   5   5   5   5   4   4
1
我最初也对这个问题感到困惑，但是lapply用于计算所有列（看看5），而不仅仅是4。 - Waldi
@Waldi 谢谢！我完全错过了那一点。现在已经更正了。 - Rui Barradas
不幸的是，它不能在不是最新版本的R上运行。 - jangorecki
@jangorecki，不要使用新的（R4.1.0）lambda函数\(x)，而是使用旧的function(x)。 - Rui Barradas
1
一种 tidyverse 的解决方案：
library(dplyr)
library(tidyr)

df %>% 
  pivot_longer(starts_with("NP")) %>% 
  count(Generacion, value)%>% 
  rbind(expand.grid(Generacion = 1:nrow(df), value = 1:6, n = 0)) %>%
  group_by(Generacion, value) %>% summarise(n = sum(n))%>%
  pivot_wider(id_cols = Generacion, names_from = value, values_from = n) %>%
  bind_cols(df %>% select(NP1:NP6))

# A tibble: 6 x 13
# Groups:   Generacion [6]
  Generacion   `1`   `2`   `3`   `4`   `5`   `6`   NP1   NP2   NP3   NP4   NP5   NP6
       <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int> <int> <int> <int> <int>
1          1     0     0     0     4     2     0     4     4     4     4     5     5
2          2     0     0     0     6     0     0     4     4     4     4     4     4
3          3     0     0     0     0     6     0     5     5     5     5     5     5
4          4     0     0     0     3     3     0     4     5     5     5     4     4
5          5     0     0     0     5     1     0     5     4     4     4     4     4
6          6     0     0     0     2     4     0     5     5     5     5     4     4
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接