R中数据中选择字符串列的和值

Question

假设我在R中有一个有两列的数据框架：value和my_letters

> my_foo
   value  my_letters
1      5     d f h b
2      3 j f i a b g
3      1   d g j f i
4      1     h i b e
5      4       c d a
6      6     i d j e
7      7     b h f i
8      5       h d g
9     10   h e i f a
10     3     h g d i

my_letters的每个元素都是3-6 非重复的字母，由空格隔开.

我能数出每封信发生的频率：

> table( unlist( strsplit( as.character(my_foo$my_letters), " " ) ) )

a b c d e f g h i j 
3 4 1 6 3 5 4 6 7 3 

但是如果我想要一个value加权和呢？

因此，a出现了三次:第2行的值为3，第5行的值为4，第9行的值为10。因此，对于a，我希望看到3+4+ 10 = 17。(注意，value可能重复)

有一种很好的plyr/dplyr/tidyr方法来做这个吗？(甚至apply.)

谢谢你！！

生成此数据框架的代码(我肯定有一种更整洁的方法)：

library( plyr )

set.seed(1)
foo    <- replicate( 10, letters[ sample( 10, sample(3:6, 1), replace = F ) ] )
foo2   <- laply( foo, function(d) paste(d, collapse = " ") )
my_foo <- data.frame( value=sample(10, replace=T), my_letters = foo2 )
my_foo

# count how often each letter appears
table( unlist( strsplit( as.character(my_foo$my_letters), " " ) ) )

Answer 1

我会使用我的"splitstackshape“包中的cSplit：

library(splitstackshape)
cSplit(my_foo, "my_letters", " ", "long")[, sum(value), by = my_letters]
#     my_letters V1
#  1:          d 24
#  2:          f 26
#  3:          h 31
#  4:          b 16
#  5:          j 10
#  6:          i 31
#  7:          a 17
#  8:          g 12
#  9:          e 17
# 10:          c  4

顺便提一下，这里有一个替代您的table行的方法：

cSplit(my_foo, "my_letters", " ", "long")[, .N, by = my_letters]

更新-基准

@nicola的基本解决方案不错，但规模不大。另一种更好的办法是使用：

xtabs(rep(as.numeric(my_foo$value), vapply(myletters, length, 1L) ~
      unlist(myletters, use.names = FALSE))

如果您期望求和值非常大，则as.numeric变得非常重要，此时xtabs会给出整数溢出错误。

下面是一些需要比较的功能：

fun1 <- function() {
  myletters <- strsplit( as.character(my_foo$my_letters), " ", TRUE)
  xtabs(rep(as.numeric(my_foo$value), 
            vapply(myletters, length, 1L)) ~ unlist(myletters))
}

fun2 <- function() cSplit(my_foo, "my_letters", " ", "long")[, sum(value), by = my_letters]

fun3a <- function() {
  myletters<-strsplit( as.character(my_foo$my_letters), " " )
  table(unlist(mapply(rep,myletters,my_foo$value)))
}

fun3b <- function() {
  myletters<-strsplit( as.character(my_foo$my_letters), " " , TRUE)
  table(unlist(mapply(rep,myletters,my_foo$value)))
}

这是样本数据。将n更改为不同尺寸的实验。我们将从1000行开始。

library( plyr )
set.seed(1)
n <- 1000
foo    <- replicate(n, letters[ sample( 10, sample(3:6, 1), replace = F ) ] )
foo2   <- laply( foo, function(d) paste(d, collapse = " ") )
my_foo <- data.frame( value=sample(n, replace=T), my_letters = foo2 )

最初的时间表：

system.time(fun1())
#    user  system elapsed 
#   0.006   0.000   0.006 
system.time(fun2())
#    user  system elapsed 
#   0.013   0.000   0.013 
system.time(fun3a())
#    user  system elapsed 
#   0.844   0.024   0.870 
system.time(fun3b())
#    user  system elapsed 
#   0.533   0.020   0.561 

下面是在生成示例数据之前使用n <- 100000的一些时间安排：

system.time(fun1())
#    user  system elapsed 
#   0.911   0.004   0.916 
system.time(fun2())
#    user  system elapsed 
#   0.537   0.004   0.551 

Answer 2

base R解决方案：

    myletters<-strsplit( as.character(my_foo$my_letters), " " )
    table(unlist(mapply(rep,myletters,my_foo$value)))

Answer 3

您可以使用base R解决方案

 table(scan(text=with(my_foo,my_letters[rep(1:nrow(my_foo),
                      value)]), sep='', what='', quiet=TRUE))

 # a  b  c  d  e  f  g  h  i  j 
 #17 16  4 24 17 26 12 31 31 10 

或count来自dplyr

lst <- strsplit( as.character(my_foo$my_letters), " " ) 
library(dplyr)
devtools::install_github("hadley/tidyr")
library(tidyr)
 unnest(setNames(lst, my_foo$value), val) %>%
                                      mutate(val=as.numeric(val)) %>%
                                      count(x, wt=val)
 #   x  n
 #1  a 17
 #2  b 16
 #3  c  4
 #4  d 24
 #5  e 17
 #6  f 26
 #7  g 12
 #8  h 31
 #9  i 31
 #10 j 10