7_kappa_alpha_imbalanced_error_rate_sim.R

rm(list = ls())

library(krippendorffsalpha)
library(kripp.boot)
library(ggplot2)
library(ggthemes)
library(tidyr)
library(dplyr)
library(psych)
source("./__simulation_functions.R")


error_rates <- c(
    seq(from = 0, to = 0.175, by = 0.025),
    seq(from = 0.2, to = 1, by = 0.1)
)

# Simulate data
kappa_alpha_list <- lapply(error_rates, \(error_rate) {
    irr_matrix <- generate_dummy_rater_data(
        error_rate = error_rate,
        prop_negative_class = 0.9
    )
    c(
        "error_rate" = error_rate,
        get_cohen_kappa(irr_matrix),
        get_k_alpha_kap(irr_matrix)
    )
})


# Create dataframe
kappa_alpha_df <- bind_rows(kappa_alpha_list) |>
    mutate(
        diff_kappa = cohen_k_upper - cohen_k_lower,
        diff_alpha = upper_kap - lower_kap
    )

#
kappa_alpha_long <- kappa_alpha_df |>
    select(
        error_rate,
        estimate_kappa = cohen_k,
        upper_kappa  = cohen_k_upper,
        lower_kappa = cohen_k_lower,
        estimate_alpha = alpha_kap,
        lower_alpha = lower_kap,
        upper_alpha = upper_kap,
        diff_alpha,
        diff_kappa
    ) |>
    pivot_longer(
        -error_rate,
        names_to = c("measure", "greek_letter"),
        names_sep = "_"
    ) |>
    pivot_wider(
        id_cols = c(error_rate, greek_letter),
        names_from = "measure"
    )

nudge_x <- rep(c(0, 0.01), nrow(kappa_alpha_long))
plot_title <- "Comparison between Krippendorf's alpha and Cohen's Kappa at different error rates"
plot_subtitle <- "0.9 negative class, 300 samples"
plot_caption <- "Note: some randomness as confidence estimates created with bootstrapping"


ggplot(kappa_alpha_long, mapping = aes(
    x = error_rate
)) +
    geom_point(
        aes(
            y = estimate,
            color = greek_letter
        ),
        position = position_nudge(
            x = nudge_x
        ),
        size = 3
    ) +
    geom_linerange(
        aes(
            ymin = lower,
            ymax = upper,
            color = greek_letter
        ),
        position = position_nudge(
            x = nudge_x
        ),
        size = 1.4
    ) +
    expand_limits(x = 0, y = 0) +
    theme_stata(base_size = 16) +
    labs(
        title = plot_title,
        subtitle = plot_subtitle,
        x = "Number of samples",
        y = "value (line represents CI)",
        caption = plot_caption
    ) +
    scale_color_stata() +
    coord_cartesian(ylim = (c(-1, 1))) +
    theme(
        legend.title = element_blank()
    )

ggsave("./plots/kappa_alpha_comparison/line_plot_error_rate_imbalanced.png", w = 12, h = 7.5)



ggplot(kappa_alpha_long) +
    geom_point(
        mapping = aes(
            x = error_rate,
            y = diff,
            color = greek_letter
        ),
        size = 3,
        position = position_nudge(
            x = nudge_x
        )
    ) +
    theme_stata(base_size = 16) +
    labs(
        title = plot_title,
        subtitle = plot_subtitle,
        x = "n",
        y = "Difference between lower and upper bound",
        caption = "Note: some randomness as confidence estimates created with bootstrapping"
    ) +
    expand_limits(x = 0, y = 0) +
    scale_color_stata() +
    theme(
        legend.title = element_blank()
    ) +
    coord_cartesian(ylim = (c(-1, 1)))

ggsave("./plots/kappa_alpha_comparison/scatter_error_rate_imbalanced.png", w = 12, h = 7.5)

write.csv(kappa_alpha_long, "./simulated_data/7_kappa_alpha_imbalanced_error_rate.csv", row.names = FALSE)