Question

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

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功能，但我没有取得任何成功。

Answer 1

# 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

Answer 2

您可以使用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

Answer 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＆＃39; s。 / p>

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

Answer 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

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

4 个答案: