计算数据框中的元素并创建新列答案

【问题标题】：counting elements in data frame and creating new colums计算数据框中的元素并创建新列
【发布时间】：2023-03-08 10:47:01
【问题描述】：

我有一个非数字数据的数据框，即，

Col1 <- c("a", "b","b",NA)
Col2 <- c(NA, "a", "c", NA)
Col3 <- c(NA,NA,"b", "a")

dat <- data.frame(Col1, Col2, Col3)
dat
# Col1 Col2 Col3
#  1    a <NA> <NA>
#  2    b    a <NA>
#  3    b    c    b
#  4 <NA> <NA>    a

我想添加列来计算每行中每个字符的出现次数。我希望数据框看起来像这样

dat
#   Col1 Col2 Col3 a b c
# 1    a <NA> <NA> 1 0 0
# 2    b    a <NA> 1 1 0
# 3    b    c    b 0 2 1
# 4 <NA> <NA>    a 1 0 0

我使用了函数

f <- function(x) {
 sum(x == "a", na.rm = T)}

要查找列“a”、“b”和“c”，但要考虑的字符很多，我希望有人能提出更快的方法。我怀疑可以使用apply 函数，但我没有成功。

【问题讨论】：

标签： r apply

【解决方案1】：

您可以使用table 计算每个因子水平。使用apply 将此函数应用于每一行。使用factor 及其levels 参数来计算（可能的）未连续表示的因子水平。第一步，我们找到数据可以取的所有可能值。

levs <- unique(unlist(dat))
count <- t(apply(dat, 1, function(x) table(factor(x, levels = levs))))
cbind(dat, count)

#   Col1 Col2 Col3 a b c
# 1    a <NA> <NA> 1 0 0
# 2    b    a <NA> 1 1 0
# 3    b    c    b 0 2 1
# 4 <NA> <NA>    a 1 0 0

【讨论】：

我相信你可以做得更好。您正在为数据集中的每一行调用table 和 factor！这似乎效率低下。
@AnandaMahto，非常感谢您的评论。我完全同意——我对此不太满意。但这就是我想到的，我没有把它扔掉，而是决定分享它……；）

【解决方案2】：

# your data
Col1<-c("a", "b","b",NA)
Col2<-c(NA, "a", "c", NA)
Col3<-c(NA,NA,"b", "a")

# the data frame. note you don't want the c() function, as you had above
dat<-data.frame(Col1,Col2,Col3, stringsAsFactors=FALSE)

解决方案：

# a vector of all the values we are searching for (less NAs)
unq_values <- unique(unlist(dat))
unq_values <- unq_values[!is.na(unq_values)]

# function: for a given unique value, count matches by row
freq_vec <- function(u) apply(dat, 1, function(x) sum(grepl(u, x)))

# now sapply() that function, and bind to your original data.frame
cbind(dat, sapply(unq_values, freq_vec))

这会产生你想要的结果：

  Col1 Col2 Col3 a b c
1    a <NA> <NA> 1 0 0
2    b    a <NA> 1 1 0
3    b    c    b 0 2 1
4 <NA> <NA>    a 1 0 0

【讨论】：

【解决方案3】：

我可能会建议这样的事情：

cbind(dat, 
      apply(table(cbind(rn = 1:nrow(dat), 
                        stack(lapply(dat, as.character)))), 
            c(1, 2), sum))

速度相当快。 Here's a Gist with the functions I ran。以下是结果。

fun1 是这个答案，fun2 是 Henrik 的，fun3 是 akrun 的，fun4 是 arvi1000 的。

library(microbenchmark)
library(reshape2)
microbenchmark(fun1(), fun2(), fun3(), fun4())
# Unit: milliseconds
#    expr      min       lq   median       uq       max neval
#  fun1() 1.882373 1.981502 2.031227 2.074144  4.193716   100
#  fun2() 2.201289 2.271821 2.316432 2.346138  5.147774   100
#  fun3() 6.565937 6.821392 6.928942 7.078843 11.700034   100
#  fun4() 2.043613 2.120811 2.151803 2.206342  5.283656   100

当然，对四行数据进行基准测试并不能很好地了解事物，所以我将其放大一点并再次测试：

dat <- do.call(rbind, replicate(5000, dat, FALSE))
dim(dat)
# [1] 20000     3
system.time(fun1())
#    user  system elapsed 
#   0.657   0.004   0.662 
system.time(fun2())
#    user  system elapsed 
#   7.730   0.029   7.787 
system.time(fun3())
#    user  system elapsed 
#  16.795   0.063  16.887 
system.time(fun4())
#    user  system elapsed 
#   2.128   0.011   2.141

【讨论】：

不错的答案（+1）！感谢您的时间！

【解决方案4】：

您还可以：

library(reshape2)    
cbind(dat,aggregate(value~Var2, melt(t(dat)), FUN=table)[,-1])
#   Col1 Col2 Col3 a b c
#1    a <NA> <NA> 1 0 0
#2    b    a <NA> 1 1 0
#3    b    c    b 0 2 1
#4 <NA> <NA>    a 1 0 0

【讨论】：