r - 如何在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 个单词，我正在考虑对字符长度执行相同的操作。

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

标签： rggplot2

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")

结果你得到了这个