5

編集 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

アップデート

これまでの結果は次のとおりです。

アクランのメソッド

提案 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

これは、1 つの文字列での複数の一致を考慮していません。期待される結果に近いですが、まだ十分ではありません。

提案 2

コメントで akrun の提案の 1 つを少し調整して、編集した投稿に適用しました

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 の提案に触発されて、これが私が最終的に最も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))

最も効率的であるため、Richard Scriven の提案 #3 を実装します。

基準

を使用して、はるかに大きなデータセット ( df93 文とdict14K 単語) に適用される提案を次に示し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
)

そして結果：

ここに画像の説明を入力

4

2 に答える 2

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

これは、1 つの文字列に複数の一致がある場合にも当てはまります。

df <- data.frame(text = c("I love love pandas", "I hate monkeys"))
# run same code as above
#[1]  3 -2
于 2015-01-21T05:58:25.850 に答える