создать фрейм данных частот тэгов из списка векторов тэгов

Question

Я пишу функцию в R, чтобы найти статистику формальности (лингвистическую меру) в типизированном диалоге. Я использую части речевого тега openNLP, чтобы помечать слова (удивительный инструмент, но медленный, потому что он делает некоторые тяжелые вещи). В любом случае, время уже является проблемой с этой функцией, и я сталкиваюсь с проблемой, которую я хочу сделать как можно быстрее. Я начал думать в запутанных терминах и знал, что мне нужно, чтобы об этом думала какая-то коллективная группа.

У меня есть список векторов с тегами, например:

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

Я положил начало своему размышлению об этом ниже, а также подделал набор данных. Сначала я подумал об этом с таблицей, но я не уверен, поскольку я знаю, что это медленнее, чем, скажем, использование 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

Извините за имя потока, так как этот трудно классифицировать.

РЕДАКТИРОВАТЬ: (добавлены результаты сравнительной оценки)

Очень креативные ответы. Я даже не думал о факторных решениях и определении уровней. Умный. Из-за скорости второй ответ Джорана переходит (я просто добавил имена столбцов, используя то, что вы уже создали lev. Ответ mdsummer был наименьшим количеством кода и был связан со скоростью секунды. Я пойду со вторым ответом Джорана как это даст мне лучший прирост скорости. Спасибо всем! Огромная благодарность :) Сравнение доступно как суть 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

Возможно, qdapTools mtabulate будет быстрым здесь:

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