Recupero punteggio frase in base ai valori di parole in un dizionario

Question

A curadf e dict

Ho un frame di dati contenente frasi:

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

e un dizionario contenente le parole ed i loro relativi punteggi:

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

Voglio aggiungere una colonna "punteggio" a df che sommare il punteggio per ogni frase:

Risultati attesi

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

Aggiornamento

ecco i risultati finora:

metodi di Akrun

Suggerimento 1

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

Si noti che per questo metodo di lavorare, ho dovuto usare data_frame() per creare df e dict invece di data.frame() altrimenti ottengo: 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 

Questo non conti più corrispondenze in una singola stringa. Vicino al risultato previsto, ma non ancora del tutto.

Suggerimento 2

ho ottimizzato un po 'uno dei suggerimento di akrun nei commenti per applicarlo al messaggio modificato

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()) 

Questo non tiene conto delle più corrispondenze in una stringa:

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

metodi di Richard Scriven

Suggerimento 1

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

Dopo aver aggiornato tutti i pacchetti, adesso funziona (anche se non tiene conto di più corrispondenze)

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 

Suggerimento 2

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

cbind(df, total) 

Questo dà il sa i risultati:

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

Suggerimento 3

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

Questo funziona davvero: metodo

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

di Thelatemail

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

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

Nota che ho aggiunto la parte cbind(). Questo in realtà corrisponde al risultato atteso.

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

risposta finale

Ispirato suggerimento di akrun, qui è quello che ho finito per scrivere come la soluzione -esque più dplyr:

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)) 

Anche se devo implementare di Richard Scriven suggerimento # 3 poiché è il più efficiente.

Benchmark

Ecco i suggerimenti applicati alle serie di dati molto più grandi (df di 93 frasi e dict di 14K parole) utilizzando microbenchmark():

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 i risultati:

Answer 1

Aggiornamento: Ecco il metodo più semplice dplyr che ho trovato finora. E aggiungerò una funzione stringi per velocizzare le cose. Purché non ci sono frasi identiche in df$text, siamo in grado di gruppo da quella colonna e quindi applicare mutate()

Nota: le versioni dei pacchetti sono dplyr 0.4.1 e stringi 0.4.1

library(dplyr) 
library(stringi) 

group_by(df, text) %>% 
    mutate(score = sum(dict$score[stri_detect_fixed(text, dict$word)])) 
# Source: local data frame [2 x 2] 
# Groups: text 
# 
#    text score 
# 1 I love pandas  2 
# 2 I hate monkeys -2 

ho rimosso il metodo do() I pubblicato ieri sera, ma puoi trovarlo nella cronologia delle modifiche. A me sembra inutile poiché il metodo sopra funziona pure ed è il modo più dplyr per farlo.

Inoltre, se si è aperti a una risposta non dplyr, qui ci sono due utilizzando le funzioni di base.

total <- with(dict, { 
    vapply(df$text, function(X) { 
     sum(score[vapply(word, grepl, logical(1L), x = X, fixed = TRUE)]) 
    }, 1) 
}) 
cbind(df, total) 
#    text total 
# 1 I love pandas  2 
# 2 I hate monkeys -2 

O in alternativa utilizzando strsplit() produce lo stesso risultato

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

Answer 2

Un po 'di doppio looping via sapply e gregexpr:

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

Questo spiega anche quando non v'è più corrispondenze in una singola stringa:

df <- data.frame(text = c("I love love pandas", "I hate monkeys")) 
# run same code as above 
#[1] 3 -2