3

假设我有一个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), " " ) ) )
4

3 回答 3

5

我会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
于 2014-11-11T15:40:10.013 回答
3

一个baseR 解决方案：

    myletters<-strsplit( as.character(my_foo$my_letters), " " )
    table(unlist(mapply(rep,myletters,my_foo$value)))
于 2014-11-11T15:44:58.553 回答
2

你可以使用一个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
于 2014-11-11T15:43:39.687 回答