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

问题描述

我有一个数据框 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的列依次表示idwordntfidftf_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)
  }
  

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

谢谢

解决方法

根据您问题的文本,我认为您正在寻找一种方法来选择性地更新名为 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 个值用星号更新。这有帮助吗?

,

也许这个代码就是你要找的。您还可以使用预训练的 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。这由您来定义。