从标签向量的列表创建标签频率的数据帧

Question

我正在R中编写一个函数，用于查找类型化对话的形式统计（一种语言度量）。我使用openNLP的词性标记器来标记单词（这是一个很棒的工具，但速度很慢，因为它正在做一些繁重的工作）。无论如何，时间已经是这个函数的一个问题了，我遇到了一个问题，我想尽快让sur-eruns成为一个问题。我开始用复杂的术语思考，知道我需要一些集体思考。

我有一个向量列表，其中有这样的标签：

G 
[[1]]
[1] "MD"  "DT"  "NN"  "VB"  "VBG" "TO"  "POS"
[[2]]
[1] "DT" "NN" "JJ" "RB"
[[3]]
[1] "RB"  "TO"  "PRP"
[[4]]
[1] "VBZ" "PRP" "VBG" "RB"  "TO"  "NN" 
[[5]]
[1] "NN" "NN"

对于每个矢量，我想计算所有可能标签的出现频率（矢量不包含标签的零将被插入），并生成如下数据帧结构：

  DT  JJ  MD  NN  POS PRP RB  TO  VB  VBG VBZ
1  1   0   1   1    1   0  0   1   1    1   0
2  1   1   0   1    0   0  1   0   0    0   0
3  0   0   0   0    0   1  1   1   0    0   0
4  0   0   0   1    0   1  1   1   1    1   1
5  0   0   0   2    0   0  0   0   0    0   0

我已经把我最初的想法和伪造的数据集放在下面。我最初想使用这个表，但我不确定9因为我知道这比使用rle或match或索引[（如果可以使用其中任何一个的话）要慢。我也想过在这些向量上使用Reduce和merge来进行多重合并，但我知道R中的高阶函数可能比其他方法慢（也许这可以通过一些甜索引来完成）。

无论如何，我非常感谢在这个问题上的帮助。我要找的两个参数是：

1. 基本解决方案
2. 速度

数据和我最初的想法（表可能是错误的做法：

G <- list(c("MD", "DT", "NN", "VB", "VBG", "TO", "POS"), c("DT", "NN", 
"JJ", "RB"), c("RB", "TO", "PRP"), c("VBZ", "PRP", "VBG", "RB", 
"TO", "NN"), c("NN", "NN"))
P <- lapply(G, function(x) table(sort(x)))  #to get frequencies on each word
sort(unique(names(unlist(P))))  #to get the column names and number

为线程名称道歉，因为这个名称很难分类

编辑：（添加了基准标记结果）

非常有创意的答案。我甚至没有考虑因素解决方案和指定级别。聪明的关于速度，Joran的第二个回答是winds（我刚刚用你已经创建的lev添加了列名。mdsummer的响应是最少的代码，与速度并列第二。我会使用Joran的第一个响应，因为它会给我带来最好的速度提升。谢谢大家！非常感谢：）可以作为要点进行比较https://gist.github.com/trinker/91802b8c4ba759034881

       expr        min         lq      mean     median        uq       max neval
   JORAN1()  648.04435  689.16756  714.9142  712.59122  732.4991  831.6623   100
   JORAN2()   86.83879   92.91911   98.7068   97.44690  101.6764  177.4228   100
   RINKER()   87.40797   94.07564  100.1154   98.39624  104.0887  177.3146   100
      TIM()  900.65847  964.23419  993.9475  988.89306 1023.0587 1137.6263   100
 MDSUMMER() 1395.95920 1487.45279 1527.3181 1527.92664 1571.0997 1685.3298   100

Answer 1

我会这样做：

lev <- sort(unique(unlist(G)))
G1 <- do.call(rbind,lapply(G,function(x,lev){ table(factor(x,levels = lev,
                                                     ordered = TRUE))},lev = lev))
     DT JJ MD NN POS PRP RB TO VB VBG VBZ
[1,]  1  0  1  1   1   0  0  1  1   1   0
[2,]  1  1  0  1   0   0  1  0  0   0   0
[3,]  0  0  0  0   0   1  1  1  0   0   0
[4,]  0  0  0  1   0   1  1  1  0   1   1
[5,]  0  0  0  2   0   0  0  0  0   0   0

或者为了更快（但丢失列名）：

G1 <- do.call(rbind,lapply(G,function(x,lev){ tabulate(factor(x,levels = lev,
                                ordered = TRUE),nbins = length(lev))},lev = lev))

Answer 2

这就是你想要的。我想，只需获得唯一值的完整列表factor levels，然后根据每个向量作为该因子的实例进行制表。

然后，你可以将整个事情封装在do.call中，并将行绑定在一起：

levs <- sort(unique(names(unlist(P))))
do.call("rbind", lapply(G, function(x) table(factor(x, levs))))

Answer 3

也许qdapToolsmtabulate在这里会很快：

library(qdapTools)
mtabulate(G)
##   DT JJ MD NN POS PRP RB TO VB VBG VBZ
## 1  1  0  1  1   1   0  0  1  1   1   0
## 2  1  1  0  1   0   0  1  0  0   0   0
## 3  0  0  0  0   0   1  1  1  0   0   0
## 4  0  0  0  1   0   1  1  1  0   1   1
## 5  0  0  0  2   0   0  0  0  0   0   0

Answer 4

这会给你想要的，但不知道它是否足够快：

    G <- list(c("MD", "DT", "NN", "VB", "VBG", "TO", "POS"), c("DT", "NN", 
            "JJ", "RB"), c("RB", "TO", "PRP"), c("VBZ", "PRP", "VBG", "RB", 
            "TO", "NN"), c("NN", "NN"))
    Tags <- sort(unique(unlist(G)))
    t(vapply(G,function(x){
        a <- Tags %in% x
        a[a] <- tapply(x %in% Tags,x,sum)
        a
    }, FUN.VALUE = rep(0,length(Tags))))
         DT JJ MD NN POS PRP RB TO VB VBG VBZ
    [1,]  1  0  1  1   1   0  0  1  1   1   0
    [2,]  1  1  0  1   0   0  1  0  0   0   0
    [3,]  0  0  0  0   0   1  1  1  0   0   0
    [4,]  0  0  0  1   0   1  1  1  0   1   1
    [5,]  0  0  0  2   0   0  0  0  0   0   0