Editado df edict

Eu tenho um quadro de dados contendo frases:

df <- data_frame(text = c("I love pandas", "I hate monkeys", "pandas pandas pandas", "monkeys monkeys"))

E um dicionário contendo palavras e suas pontuações correspondentes:

dict <- data_frame(word = c("love", "hate", "pandas", "monkeys"),
                   score = c(1,-1,1,-1))

Quero acrescentar uma coluna "pontuação" adf que somaria a pontuação para cada frase:

Resultados esperados

                  text score
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     3
4      monkeys monkeys    -2

Atualizar

Aqui estão os resultados até agora:

Métodos de Akrun

Sugestão 1

df %>% mutate(score = sapply(strsplit(text, ' '), function(x) with(dict, sum(score[word %in% x]))))

Observe que, para esse método funcionar, eu tive que usardata_frame() para criardf edict ao invés dedata.frame() caso contrário, eu recebo:Error in strsplit(text, " ") : non-character argument

Source: local data frame [4 x 2]

                  text score
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     1
4      monkeys monkeys    -1

Isso não considera várias correspondências em uma única sequência. Perto do resultado esperado, mas ainda não chegou.

Sugestão 2

Eu alterei um pouco a sugestão de akrun nos comentários para aplicá-la ao post editado

cbind(df, unnest(stri_split_fixed(df$text, ' '), group) %>% 
        group_by(group) %>% 
        summarise(score = sum(dict$score[dict$word %in% x])) %>% 
        ungroup() %>% select(-group) %>% data.frame())

Isso não considera várias correspondências em uma sequência:

                  text score
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     1
4      monkeys monkeys    -1

Métodos de Richard Scriven

Sugestão 1

group_by(df, text) %>%
mutate(score = sum(dict$score[stri_detect_fixed(text, dict$word)]))

Depois de atualizar todos os pacotes, isso agora funciona (embora não seja responsável por várias correspondências)

Source: local data frame [4 x 2]
Groups: text

                  text score
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     1
4      monkeys monkeys    -1

Sugestão 2

total <- with(dict, {
  vapply(df$text, function(X) {
    sum(score[vapply(word, grepl, logical(1L), x = X, fixed = TRUE)])
  }, 1)
})

cbind(df, total)

Isso fornece os mesmos resultados:

                  text total
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     1
4      monkeys monkeys    -1

Sugestão 3

s <- strsplit(df$text, " ")
total <- vapply(s, function(x) sum(with(dict, score[match(x, word, 0L)])), 1)
cbind(df, total)

Isso realmente funciona:

                  text total
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     3
4      monkeys monkeys    -2

O método de email

res <- sapply(dict$word, function(x) {
  sapply(gregexpr(x,df$text),function(y) length(y[y!=-1]) )
})

cbind(df, score = rowSums(res * dict$score))

Observe que eu adicionei ocbind() parte. Na verdade, isso corresponde ao resultado esperado.

                  text score
1        I love pandas     2
2       I hate monkeys    -2
3 pandas pandas pandas     3
4      monkeys monkeys    -2

Resposta final

Inspirado na sugestão de akrun, eis o que acabei escrevendo como o maisdplyrSolução não esquisita:

library(dplyr)
library(tidyr)
library(stringi)

bind_cols(df, unnest(stri_split_fixed(df$text, ' '), group) %>% 
            group_by(x) %>% mutate(score = sum(dict$score[dict$word %in% x])) %>% 
            group_by(group) %>% 
            summarise(score = sum(score)) %>% 
            select(-group))

Embora eu implemente a sugestão nº 3 de Richard Scriven, uma vez que é a mais eficiente.

Referência

Aqui estão as sugestões aplicadas a conjuntos de dados muito maiores (df de 93 frases edict de 14K palavras) usandomicrobenchmark():

mbm = microbenchmark(
  akrun = df %>% mutate(score = sapply(stri_detect_fixed(text, ' '), function(x) with(dict, sum(score[word %in% x])))),
  akrun2 = cbind(df, unnest(stri_split_fixed(df$text, ' '), group) %>% group_by(group) %>% summarise(score = sum(dict$score[dict$word %in% x])) %>% ungroup() %>% select(-group) %>% data.frame()),
  rscriven1 = group_by(df, text) %>% mutate(score = sum(dict$score[stri_detect_fixed(text, dict$word)])),
  rscriven2 = cbind(df, score = with(dict, { vapply(df$text, function(X) { sum(score[vapply(word, grepl, logical(1L), x = X, fixed = TRUE)])}, 1)})),
  rscriven3 = cbind(df, score = vapply(strsplit(df$text, " "), function(x) sum(with(dict, score[match(x, word, 0L)])), 1)),
  thelatemail = cbind(df, score = rowSums(sapply(dict$word, function(x) { sapply(gregexpr(x,df$text),function(y) length(y[y!=-1]) ) }) * dict$score)),
  sbeaupre = bind_cols(df, unnest(stri_split_fixed(df$text, ' '), group) %>% group_by(x) %>% mutate(score = sum(dict$score[dict$word %in% x])) %>% group_by(group) %>% summarise(score = sum(score)) %>% select(-group)),
  times = 10
)

E os resultados: