Получение баллов предложение на основе значений слов в словаре

Question

Отредактированоdf и dict

У меня есть кадр данных, содержащий предложения:

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

и словарь, содержащий слова и соответствующие им баллы:

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

Я хочу добавить столбец «оценка» в df, что бы просуммировать балл для каждого предложения:

Ожидаемые результаты

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

Update

Вот результаты до сих пор:

методы Akrun в

Предложение 1

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

Обратите внимание, что для работы этого метода, я должен был использовать data_frame() создать df и dict вместо data.frame() иначе я получаю: 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 

Это не счета для несколько совпадений в одной строке. Близко к ожидаемому результату, но пока не совсем.

Предложение 2

Я подправил немного один внушение akrun в комментариях, чтобы применить его к редактируемой сообщению

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

Это не учитывает множества совпадений в строке:

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

Методы Ричарда Скривена

Предложение 1

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

После обновления всех пакетов, это теперь работает (хотя он не учитывает нескольких матчей)

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 

Предложение 2

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 
3 pandas pandas pandas  1 
4  monkeys monkeys -1 

Предложение 3

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

Это на самом деле работает: метод

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

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

Обратите внимание, что я добавил часть cbind(). Это фактически соответствует ожидаемому результату.

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

Окончательный ответ

Вдохновленный предложением akrun, вот то, что я в конечном итоге написание как -esque решения наиболее 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)) 

Хотя я реализую Ричарда Скривен по рекомендации # 3, так как это наиболее эффективно.

Benchmark

Вот предложения, применяемые для более крупных наборов данных (df 93 предложений и dict из 14K слов) с помощью 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 
) 

И результаты:

Answer 1

Обновление: Вот самый простой метод dplyr, который я нашел до сих пор. И я добавлю функцию stringi, чтобы ускорить процесс. При условии, что не существует одинаковых предложений в df$text, мы можем группу по этой колонке, а затем применить mutate()

Примечание: версии пакета являются dplyr 0.4.1 и стринги 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 

Я удалил метод do() I опубликованном прошлой ночью, но вы можете найти его в истории изменений. Для меня это кажется ненужным, так как вышеупомянутый метод работает так же хорошо и тем более dplyr способ сделать это.

Кроме того, если вы открыты для ответа не dplyr, здесь два используются с использованием базовых функций.

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 

Или альтернатива использования strsplit() дает тот же результат

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

Answer 2

Немного двойной сквозными через sapply и 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 

Это также объясняет, когда есть несколько матчей в одна строка:

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