使用 word2vec 替换数据帧 R 中频率较低的单词

Question

我有一个数据框 data1，其中包含与其 ID 匹配的已清理文本字符串

    # A tibble: 2,000 x 2
      id text                                                                                                                            
   <int> <chr>                                                                                                                           

     1 decent scene guys visit spanish lady hilarious flamenco music background re…
     3 movie beautiful plot depth kolossal scenes battles moral rationale br br conclusion wond…
     4 fan scream killing astonishment story summarized don time move ii won regret plot ironical              
     5 mistake film guess minutes clunker fought hard stay seat lose hours life feeling br his…
     6 phoned awful bed dog ranstuck br br positive grooming eldest daughter beeeatch br ous…
    
    # … with 1,990 more rows

并创建了一个新变量freq，它为每个单词提供了 tf、pdf 和 itidf。 freq的列依次表示id、word、n、tf、idf、tf_idf

# A tibble: 112,709 x 6
      id word           n    tf   idf tf_idf
   <int> <chr>      <int> <dbl> <dbl>  <dbl>
 1   335 starcrash      1 0.5    7.60   3.80
 2  2974 carly          1 0.5    6.50   3.25
 3  1796 phillips       1 0.5    5.81   2.90
 4  1796 eric           1 0.5    5.40   2.70
 5  1398 wilson         1 0.5    5.20   2.60
 6   684 apolitical     1 0.333  7.60   2.53
 7  1485 saimin         1 0.333  7.60   2.53
 8  1398 charlie        1 0.5    4.77   2.38
 9  2733 shouldn        1 0.5    4.71   2.36
10  2974 jones          1 0.5    4.47   2.23
# … with 112,699 more rows

我正在尝试创建一个循环，该循环通过第二个变量并使用 word2vec 在data1 中替换任何低于所有其他单词均值的 tf 单词，并具有最接近的匹配。 这个功能我试过了

 replace_word <- function(x) {
   x<-hunspell_suggest(x)
   x<-mutate(x)
   p<-system.file(package = "word2vec", "models", "example.bin")
   m<-read.word2vec(p)
   s<-predict(m, x, type='nearest', top_n=1)
   paste0(s)
  }
  

但是当我运行它时，它进入了一个无限循环。我本来想先检查单词的拼写是否正确，但是因为字典中没有的单词一直出错。 因为我以前从来没有做过这样的事情，我真的不知道如何让它工作。有人可以帮忙吗？

谢谢

Answer 1

也许这段代码是您正在寻找的。您还可以使用预级Word2Vec模型，在下面的示例中，Word2Vec模型验证您的数据（更多信息，https://www.bnosac.be/index.php/blog/100-word2vec-in-r）

library(word2vec)
library(udpipe)
data(brussels_reviews, package = "udpipe")
x <- subset(brussels_reviews, language == "nl")

data1 <- data.frame(id = x$id, text = tolower(x$feedback), stringsAsFactors = FALSE) 
str(data1)
#> 'data.frame':    500 obs. of  2 variables:
#>  $ id  : int  19991431 21054450 22581571 23542577 40676307 46755068 23831365 23016812 46958471 28687866 ...
#>  $ text: chr  "zeer leuke plek om te vertoeven , rustig en toch erg centraal gelegen in het centrum van brussel , leuk adres o"| __truncated__ "het appartement ligt op een goede locatie: op loopafstand van de europese wijk en vlakbij verschilende metrosta"| __truncated__ "bedankt bettina en collin. ik ben heel blij dat ik bij jullie heb verbleven, in zo'n prachtige stille omgeving "| __truncated__ "ondanks dat het, zoals verhuurder joffrey zei, geen last minute maar een last seconde boeking was, is alles per"| __truncated__ ...
freq <- strsplit.data.frame(data1, term = "text", group = "id", split = "[[:space:][:punct:][:digit:]]+")
freq <- document_term_frequencies(freq)
freq <- document_term_frequencies_statistics(freq)
freq <- freq[, c("doc_id", "term", "freq", "tf", "idf", "tf_idf")]
head(freq)
#>      doc_id      term freq      tf       idf     tf_idf
#> 1: 19991431      zeer    1 0.03125 1.5702172 0.04906929
#> 2: 19991431     leuke    1 0.03125 1.9519282 0.06099776
#> 3: 19991431      plek    1 0.03125 2.5770219 0.08053194
#> 4: 19991431        om    2 0.06250 1.4105871 0.08816169
#> 5: 19991431        te    2 0.06250 0.9728611 0.06080382
#> 6: 19991431 vertoeven    1 0.03125 4.6051702 0.14391157

## Build word2vec model
set.seed(123456789)
w2v <- word2vec(x = data1$text, dim = 15, iter = 20, min_count = 0, lr = 0.05, type = "cbow")
vocabulary <- summary(w2v, type = "vocabulary")
## For each word, find the most similar one if it is part of the word2vec vocabulary
freq$similar_word <- ifelse(freq$term %in% vocabulary, freq$term, NA)
freq$similar_word <- lapply(freq$similar_word, FUN = function(x){
    if(!is.na(x)){
        x <- predict(w2v, x, type = 'nearest', top_n = 1)
        x <- x[[1]]$term2
    }
    x
})
head(freq)
#>      doc_id      term freq      tf       idf     tf_idf  similar_word
#> 1: 19991431      zeer    1 0.03125 1.5702172 0.04906929     plezierig
#> 2: 19991431     leuke    1 0.03125 1.9519282 0.06099776         cafes
#> 3: 19991431      plek    1 0.03125 2.5770219 0.08053194 opportuniteit
#> 4: 19991431        om    2 0.06250 1.4105871 0.08816169    verblijven
#> 5: 19991431        te    2 0.06250 0.9728611 0.06080382   overnachten
#> 6: 19991431 vertoeven    1 0.03125 4.6051702 0.14391157  comfortabele

现在你的阈值0.5。这取决于你来定义。

Answer 2

按照您的问题文本，我认为您正在寻找一种方法来选择性地更新名为 word 的列的值，该列的值在名为 freq 的数据框中使用专门的函数来查找替换值，但是仅适用于 tf 的值低于设定阈值的行。为此，这里有一个使用 tidyverse 方法的示例，对您的单词替换算法进行了一些简化。

library(tidyverse)

# a placeholder for your word replacement function
replace_word <- function(x) {
    paste0(x, "*")
}

# Creating some simplified example data to work with
freq <- tibble(
    id = c(1, 2, 3, 4, 5),
    word = c("aa", "bb", "cc", "dd", "ee"),
    tf = c(0.001, 0.003, 0.005, 0.007, 0.009)
) 

print(freq)

# A tibble: 5 x 3
     id word     tf
  <dbl> <chr> <dbl>
1     1 aa    0.001
2     2 bb    0.003
3     3 cc    0.005
4     4 dd    0.007
5     5 ee    0.009

# Making changes to a column using `mutate()` and `if_else()` to do so conditionally.
freq <- freq %>%
    mutate(
        word = if_else(tf < 0.007, replace_word(word), word)
    )
    
print(freq)

# A tibble: 5 x 3
     id word     tf
  <dbl> <chr> <dbl>
1     1 aa*   0.001
2     2 bb*   0.003
3     3 cc*   0.005
4     4 dd    0.007
5     5 ee    0.009

word 的前 3 个值用星号更新。这有帮助吗？