R:使用马尔可夫模型进行Gibberish检测(如何调整文本长度)

Question

首先，我从一个德语文本文件中创建一个包含两个字母组合频率的表:

# Load a German language text file
text <- read_tsv("http://www.reduts.net/deutsch.txt")
colnames(text) <- c("id", "text")
text <- paste(text$text, collapse = " ")
# Calculate all two-letters-combinations
tokens_char <- function(str, window = 2) {
str <- stringi::stri_replace_all_regex(str, "\W", "")
str <- tolower(str)
win <- window - 1
len1 <- seq_len(nchar(str) - win)
stringi::stri_sub(str, from = len1, to = len1 + win)
}

创建一个包含两列的查询表:两个字母的组合和2。所有组合在文本中出现的频率:

lookuptable <- tibble(
token = tokens_char(text, window = 2) 
) %>% count(token, sort = TRUE) %>%
mutate(token2 = token) %>%
separate(token, into = c("first", "second"), sep = 1) %>%
group_by(first) %>%
mutate(total = sum(n),
freq = n / total) %>%
ungroup() %>%
mutate(token = token2,
token2 = NULL,
first = NULL,
second = NULL,
total = NULL) %>%
select(token, freq)
> lookuptable
# A tibble: 1,522 x 2
token  freq
<chr> <dbl>
1 en    0.233
2 er    0.225
3 ch    0.861
4 de    0.446
5 ei    0.127
6 te    0.302
7 nd    0.186
8 in    0.228
9 ie    0.209
10 ge    0.494
# ... with 1,512 more rows

然后，我有一个函数，用于计算给定文本中所有2字母组合的频率乘积。例如单词"test"我查找的概率是"es"one_answers";st"。然后将这些概率相乘:P("te") * P("es") * P("st"):

lookup_text <- function(text = ""){
df <- data.frame(token = tokens_char(text, window = 2)) %>%
left_join(lookuptable, by = "token") 

# Return product of all probabilities
return(prod(df$freq))
}

现在，我可以很容易地检查给定文本是胡言乱语还是真实文本的可能性。

> lookup_text("test")
[1] 0.004262462

只有一个主要的缺点:显然，我得到的值在很大程度上取决于我想要检查的字符串的长度。所以我的问题是:我怎样才能解决这个问题?

在这个威胁中(有没有办法检测像putjbtghguhjjjanika这样的字符串?)有人写道:"然后按查询的长度进行规范化。"但是如何做到这一点呢?谢谢你的帮助!

Answer 1

我认为你基本上是在寻找均值而不是产品:

lookup_text <- function(text = ""){
df <- data.frame(token = tokens_char(text, window = 2)) %>%
left_join(lookuptable, by = "token") 

return(mean(df$freq))
}
lookup_text(text = "Test")
#> [1] 0.1889944
lookup_text(text = "Tests")
#> [1] 0.1582075
lookup_text(text = "Testkandidaten")
#> [1] 0.1540773
lookup_text(text = "Quer")
#> [1] 0.397371

我包含了最后一个例子，因为我注意到一些不寻常的组合在您的查找表中得分很高，例如，";但这不是问题的一部分。

您需要解决的一个问题是，如果查找表中没有字母组合会发生什么。目前，这导致NA。我认为在这种情况下概率应该是0:

lookup_text <- function(text = ""){
df <- data.frame(token = tokens_char(text, window = 2)) %>%
left_join(lookuptable, by = "token") 

return(mean(df$freq, na.rm = TRUE) * !any(is.na(df$freq)))
}

lookup_text(text = "qjbstz")
#> [1] 0

^{由reprex包(v2.0.1)于2022-04-22创建}