我正在研究会话轮次中的语音，并希望提取跨轮次重复的单词。我正在努力完成的任务是提取不准确地重复的单词。
数据：
X <- data.frame(
speaker = c("A","B","A","B"),
speech = c("i'm gonna take a look you okay with that",
"sure looks good we can take a look you go first",
"okay last time I looked was different i think that is it yeah",
"yes you're right i think that's it"), stringsAsFactors = F
)
我有一个for循环，它成功地提取了精确的重复：
# initialize vectors:
pattern1 <- c()
extracted1 <- c()
# run `for` loop:
library(stringr)
for(i in 2:nrow(X)){
# define each 'speech` element as a pattern for the next `speech` element:
pattern1[i-1] <- paste0("\b(", paste0(unlist(str_split(X$speech[i-1], " ")), collapse = "|"), ")\b")
# extract all matched words:
extracted1[i] <- str_extract_all(X$speech[i], pattern1[i-1])
}
# result:
extracted1
[[1]]
NULL
[[2]]
[1] "take" "a" "look" "you"
[[3]]
character(0)
[[4]]
[1] "i" "think" "that" "it"
但是，我也想提取不精确的重复。例如，第2行中的looks是第1行中look的不精确重复，第3行中的looked模糊地重复第2行的looks，而第4行中的yes是第3行的yeah的近似匹配。我最近遇到了agrep，它用于近似匹配，但我不知道如何在这里使用它，也不知道它是否是正确的方法。非常感谢您的帮助。
请注意实际数据包括数千次演讲，内容高度不可预测，因此无法预先定义所有可能的变体列表。
我认为使用整洁方法可以很好地完成这项工作。您已经解决的问题可以使用tidytext:完成(可能更快(
library(tidytext)
library(tidyverse)
# transform text into a tidy format
x_tidy <- X %>%
mutate(id = row_number()) %>%
unnest_tokens(output = "word", input = "speech")
# join data.frame with itself just moved by one id
x_tidy %>%
mutate(id_last = id - 1) %>%
semi_join(x_tidy, by = c("id_last" = "id", "word" = "word"))
#> speaker id word id_last
#> 2.5 B 2 take 1
#> 2.6 B 2 a 1
#> 2.7 B 2 look 1
#> 2.8 B 2 you 1
#> 4.3 B 4 i 3
#> 4.4 B 4 think 3
#> 4.6 B 4 it 3
当然，你想做的事情有点复杂。你强调的示例单词并不完全相同，但Levenstein距离高达2:
adist(c("look", "looks", "looked"))
#> [,1] [,2] [,3]
#> [1,] 0 1 2
#> [2,] 1 0 2
#> [3,] 2 2 0
adist(c("yes", "yeah"))
#> [,1] [,2]
#> [1,] 0 2
#> [2,] 2 0
有一个很好的软件包，遵循同样的小逻辑。不幸的是，相应函数中的by参数似乎无法处理两列(或者它对两列都应用了模糊逻辑，所以0和2被视为相同？(，所以这不起作用：
x_tidy %>%
mutate(id_last = id - 1) %>%
fuzzyjoin::stringdist_semi_join(x_tidy, by = c("word" = "word", "id_last" = "id"), max_dist = 2)
然而，使用循环，我们无论如何都可以实现缺失的功能：
library(fuzzyjoin)
map_df(unique(x_tidy$id), function(i) {
current <- x_tidy %>%
filter(id == i)
last <- x_tidy %>%
filter(id == i - 1)
current %>%
fuzzyjoin::stringdist_semi_join(last, by = "word", max_dist = 2)
})
#> speaker id word
#> 2.1 B 2 looks
#> 2.2 B 2 good
#> 2.3 B 2 we
#> 2.4 B 2 can
#> 2.5 B 2 take
#> 2.6 B 2 a
#> 2.7 B 2 look
#> 2.8 B 2 you
#> 2.9 B 2 go
#> 3.2 A 3 time
#> 3.3 A 3 i
#> 3.4 A 3 looked
#> 3.5 A 3 was
#> 3.7 A 3 i
#> 3.10 A 3 is
#> 3.11 A 3 it
#> 4 B 4 yes
#> 4.3 B 4 i
#> 4.4 B 4 think
#> 4.5 B 4 that's
#> 4.6 B 4 it
创建于2021-04-22由reprex包(v2.0.0(
我不确定在你的情况下距离有多理想，也不确定你是否认为结果正确。或者，您可以在匹配之前尝试词干或旅名化，这可能会更好。我还为实现stringsim_join版本的包编写了一个新函数，该函数考虑了要匹配的单词的长度。但是公关还没有得到批准。