来自R中数据框中的select strsplit列的和值

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

我会使用cSplit我的"splitstackshape"包:

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不同尺寸的实验.我们将从适度的1,000行开始.

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