如何在R中使用移动阈值绘制百分比

Question

我正在一个项目中使用多个语言检测算法，例如Textcat和CLD3。我有一个数据框，其中记录了一段文本的编写语言，每种算法的猜测以及该猜测是否正确。

由于字符串的长度差异很大，因此我想评估每个算法在移动阈值上的性能（例如，对于所有5个单词以上，然后10个单词以上的字符串，等等）

数据如下：

Text    Language CLD Textcat Word_count CLD_correct Textcat_correct 
String1 EN       en  en      20         1           1
String2 EN       NA  fr      5          0           0
String3 FR       fr  es      10         1           0
String4 ES       ca  es      7          0           1

我非常想做的是根据单词的数量绘制每个阈值的准确性。例如，我发现整体CLD在75％的情况下正确地标记了语言。但是，如果只考虑7个单词或更多的字符串，则最多可以达到85％。

因此，我想在x轴上绘制阈值的单词数，在y轴上绘制该算法做出的正确猜测的百分比。

我知道如何手动执行此操作（将数据框的值设置为Word_count> x，计算每种算法的精度，将其存储在数据框中，计算Word_count> y，依此类推，然后对其进行绘制） ，但是由于我的样本很大，因此需要花大量的工作来完成所有这些工作，并且必须有一种更明智的方法来完成此工作。我考虑过使用for循环遍历不同的阈值来为每个阈值计算值，然后存储这些值，但是此数据集中的大部分字符串可能超过100个字，并且我正在考虑对字符长度执行相同的操作。

有人知道如何以更自动化的方式解决此问题吗？

Answer 1

首先定义一个使用算法的向量

algorithmrithms <- c('Textcat_correct', 'CLD_correct')

然后使用您要查看其准确性的单词数创建一个向量

word.size <- seq(5, 20, 5)

现在，您可以使用软件包dplyr和lapply来获取每个单词数量和算法的列表。

library(dplyr)
resultList <- lapply(word.size, function(y) { 
    lapply(algorithm, function(x) { 
        df %>%
        rename(algorithm = x) %>%
        filter(Word_count >= y) %>%
        group_by(algorithm) %>%
         summarise(all = sum(Word_count)) %>%
         mutate(accuracy = all/sum(all)*100) %>%
         filter(algorithm == 1) %>%
         mutate(algorithm=replace(algorithm, algorithm == 1, x)) %>%
         mutate(words = y) })
    })

此列表可以转换为数据框

df2 <- as.data.frame(do.call(rbind, unlist(resultList, recursive=F)))

现在您可以绘制结果

library(ggplot2)
ggplot(df2, aes(words, accuracy, fill=algorithm)) + 
    geom_bar(stat="identity", position="dodge")

结果您得到了