Ergänzung: Validierung kategoriespezifisches Encoder-Modell

Beispielstudie

Um die Validität der verschiedenen Verfahren zu vergleichen, wurden die Codierergebnisse aller Verfahren mit der Codierung des Goldstandards verglichen.

Einlesen der Daten

Zunächst werden die Daten eingelesen und in ein einheitliches Format gebracht.

Code 
R
library(tidyverse)
library(hrbrthemes)
library(yardstick)
library(rsample)
library(tidycomm)
theme_set(theme_ipsum_rc())

gold <-
  read_csv(here::here("beispielstudie/data/00_goldstandard.csv")) |>
  mutate(

    id = id,
    sentiment_gold = case_when(

      sentiment_gs == -1 ~ "negativ",
      sentiment_gs == 0 ~ "neutral",
      sentiment_gs == 1 ~ "positiv"
    ),
    textart = case_when(

      textart == "Facebook-Post" ~ "Facebook-Post",
      textart == "Tweet" ~ "Tweet",
      textart == "Zeitungsartikel Online" ~ "Zeitungsartikel",
      textart == "Zeitungsartikel Offline" ~ "Zeitungsartikel"
    ),
    .keep = "none"
  )

kategoriespezifisches_encoder_modell <-
  read_csv(here::here(

    "beispielstudie/data/01_kategoriespezifisches_Encoder-Modell.csv"
  )) |>
  mutate(

    id = id,
    sentiment_kategoriespezifisches_encoder_modell = case_when(

      label == "neutral" ~ "neutral",
      label == "positive" ~ "positiv",
      label == "negative" ~ "negativ"
    ),
    .keep = "none"
  )

kategoriespezifisches_encoder_modell_chunked <-
  read_csv(here::here(

    "beispielstudie/data/01_kategoriespezifisches_Encoder-Modell_chunked.csv"
  )) |>
  mutate(

    id = id,
    sentiment_kategoriespezifisches_encoder_modell = case_when(

      aggregated_label == "neutral" ~ "neutral",
      aggregated_label == "positive" ~ "positiv",
      aggregated_label == "negative" ~ "negativ"
    ),
    .keep = "none"
  )

kategoriespezifisches_encoder_modell_preprocessed <-
  read_csv(here::here(

    "beispielstudie/data/01_kategoriespezifisches_Encoder-Modell_preprocessed.csv"
  )) |>
  mutate(

    id = id,
    sentiment_kategoriespezifisches_encoder_modell = case_when(

      label == "neutral" ~ "neutral",
      label == "positive" ~ "positiv",
      label == "negative" ~ "negativ"
    ),
    .keep = "none"
  )

validierung <-
  gold |>
  left_join(kategoriespezifisches_encoder_modell, by = "id") |>
  left_join(kategoriespezifisches_encoder_modell_chunked, by = "id", suffix = c("", "_chunked")) |>
  left_join(kategoriespezifisches_encoder_modell_preprocessed, by = "id", suffix = c("", "_preprocessed")) |>
  mutate(across(everything(), as.factor))
1
Import der notwendigen Bibliotheken für Datenverarbeitung, Visualisierung, Validierungsmetriken, Bootstrap-Sampling und Inter-Coder-Reliabilität.
2
Laden des Goldstandards und Konvertierung der numerischen Sentiment-Werte zu kategorialen Labels sowie Vereinheitlichung der Textarten.
3
Laden der kategoriespezifischen Encoder-Modell Ergebnisse und Konvertierung der Label-Namen zu einheitlichen deutschen Kategorien.
4
Laden der Chunked-Version des kategoriespezifischen Encoder-Modells und Konvertierung der Labels.
5
Laden der Preprocessed-Version des kategoriespezifischen Encoder-Modells und Konvertierung der Labels.
6
Zusammenführen aller Datensätze in einen einzigen Dataframe für die Validierung.

Validierung der Codierergebnisse

Anschließend werden die Validierungsmetriken für alle Verfahren berechnet. Dazu gehören Accuracy, Recall, Precision, F1-Score und Krippendorff’s Alpha. Die Metriken werden mittels Bootstrap-Sampling mit 2000 Wiederholungen geschätzt, um robuste Punktschätzer und 95%-Konfidenzintervalle zu erhalten. Dies wird für den gesamten Datensatz sowie separat für Facebook-Posts, Tweets und Zeitungsartikel durchgeführt.

Code 
R
calculate_vali_metrics <- function(data, var) {
  vali_metrics <- metric_set(accuracy, recall, precision, f_meas)
  bind_cols(
    vali_metrics(
      data = data,
      truth = sentiment_gold,
      estimate = all_of(var)
    ) |>
      select(-.estimator) |>
      pivot_wider(names_from = .metric, values_from = .estimate),

    data |>
      select(-id) |>
      rowid_to_column(var = "id") |>
      select(id, sentiment_gold, all_of(var)) |>
      pivot_longer(-id, names_to = "method", values_to = "sentiment") |>
      mutate(
        sentiment = case_when(
          sentiment == "negativ" ~ -1,
          sentiment == "neutral" ~ 0,
          sentiment == "positiv" ~ 1
        )
      ) |>
      test_icr(
        unit_var = id,
        coder_var = method,
        kripp_alpha = TRUE,
        levels = c(sentiment = "interval")
      ) |>
      select(Krippendorffs_Alpha) |>
      rename(kripp_alpha = Krippendorffs_Alpha)
  )
}

bootstrap_vali_metrics <- function(data, times) {
  data |>
    bootstraps(times = times, apparent = TRUE) |>
    mutate(
      metrics = map(
        splits,
        \(split) {
          split |>
            analysis() %>%
            summarise(
              sentiment_kategoriespezifisches_encoder_modell = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_kategoriespezifisches_encoder_modell"
              )),
              sentiment_kategoriespezifisches_encoder_modell_chunked = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_kategoriespezifisches_encoder_modell_chunked"
              )),
              sentiment_kategoriespezifisches_encoder_modell_preprocessed = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_kategoriespezifisches_encoder_modell_preprocessed"
              ))
            ) |>
            pivot_longer(everything()) |>
            unnest(value)
        },
        .progress = TRUE
      )
    ) |>
    unnest(metrics) |>
    group_by(name) |>
    reframe(
      accuracy_point = accuracy[id == "Apparent"],
      accuracy_lower = quantile(accuracy[id != "Apparent"], 0.025),
      accuracy_upper = quantile(accuracy[id != "Apparent"], 0.975),
      recall_point = recall[id == "Apparent"],
      recall_lower = quantile(recall[id != "Apparent"], 0.025),
      recall_upper = quantile(recall[id != "Apparent"], 0.975),
      precision_point = precision[id == "Apparent"],
      precision_lower = quantile(precision[id != "Apparent"], 0.025),
      precision_upper = quantile(precision[id != "Apparent"], 0.975),
      f_meas_point = f_meas[id == "Apparent"],
      f_meas_lower = quantile(f_meas[id != "Apparent"], 0.025),
      f_meas_upper = quantile(f_meas[id != "Apparent"], 0.975),
      kripp_alpha_point = kripp_alpha[id == "Apparent"],
      kripp_alpha_lower = quantile(kripp_alpha[id != "Apparent"], 0.025),
      kripp_alpha_upper = quantile(kripp_alpha[id != "Apparent"], 0.975)
    )
}

if (
  !file.exists(here::here("beispielstudie/data/exploratory/07_vali_metrics_complete.csv"))
) {
  set.seed(42)
  validierung |>
    bootstrap_vali_metrics(times = 2000) |>
    write_csv(here::here("beispielstudie/data/exploratory/07_vali_metrics_complete.csv"))
}

if (
  !file.exists(here::here("beispielstudie/data/exploratory/07_vali_metrics_facebook.csv"))
) {
  set.seed(42)
  validierung |>
    filter(textart == "Facebook-Post") |>
    bootstrap_vali_metrics(times = 2000) |>
    write_csv(here::here("beispielstudie/data/exploratory/07_vali_metrics_facebook.csv"))
}

if (
  !file.exists(here::here("beispielstudie/data/exploratory/07_vali_metrics_twitter.csv"))
) {
  set.seed(42)
  validierung |>
    filter(textart == "Tweet") |>
    bootstrap_vali_metrics(times = 2000) |>
    write_csv(here::here("beispielstudie/data/exploratory/07_vali_metrics_twitter.csv"))
}

if (
  !file.exists(here::here(
    "beispielstudie/data/exploratory/07_vali_metrics_zeitungsartikel.csv"
  ))
) {
  set.seed(42)
  validierung |>
    filter(textart == "Zeitungsartikel") |>
    bootstrap_vali_metrics(times = 2000) |>
    write_csv(here::here(
      "beispielstudie/data/exploratory/07_vali_metrics_zeitungsartikel.csv"
    ))
}
1
Definition einer Hilfsfunktion zur Berechnung von Validierungsmetriken: Berechnung von Accuracy, Recall, Precision, F1-Score und Krippendorff’s Alpha für eine gegebene Variable gegen den Goldstandard.
2
Definition einer Bootstrap-Funktion für robuste Schätzung der Validierungsmetriken: Durchführung von Bootstrap-Sampling, Berechnung der Metriken für jede Stichprobe und alle Methoden, sowie Bestimmung von Punktschätzern und Konfidenzintervallen.
3
Bootstrap-Validierung für den gesamten Datensatz: Prüfung auf Existenz der Datei, falls nicht vorhanden Bootstrap mit 2000 Wiederholungen und Speicherung.
4
Bootstrap-Validierung spezifisch für Facebook-Posts: Filterung nach Facebook-Posts und separate Bootstrap-Validierung.
5
Bootstrap-Validierung spezifisch für Tweets: Filterung nach Tweets und separate Bootstrap-Validierung.
6
Bootstrap-Validierung spezifisch für Zeitungsartikel: Filterung nach Zeitungsartikeln und separate Bootstrap-Validierung.

Plot

Zuletzt wird ein Plot erstellt, der die Validierungsmetriken für alle Verfahren und Textarten visualisiert.

Code 
R
plot_data <-
  bind_rows(
    read_csv(here::here("beispielstudie/data/exploratory/07_vali_metrics_complete.csv")) |>
      mutate(Textart = "Gesamt"),
    read_csv(here::here("beispielstudie/data/exploratory/07_vali_metrics_facebook.csv")) |>
      mutate(Textart = "Facebook-Post"),
    read_csv(here::here("beispielstudie/data/exploratory/07_vali_metrics_twitter.csv")) |>
      mutate(Textart = "Tweet"),
    read_csv(here::here(
      "beispielstudie/data/exploratory/07_vali_metrics_zeitungsartikel.csv"
    )) |>
      mutate(Textart = "Zeitungsartikel")
  ) |>
  mutate(
    Methode = case_when(
      name == "sentiment_kategoriespezifisches_encoder_modell" ~
        "Kategoriespezifisches Encoder-Modell",
      name == "sentiment_kategoriespezifisches_encoder_modell_preprocessed" ~
        "Kategoriespezifisches Encoder-Modell (Preprocessed)",
      name == "sentiment_kategoriespezifisches_encoder_modell_chunked" ~
        "Kategoriespezifisches Encoder-Modell (Chunked)"
    ),
    Methode = factor(
      Methode,
      levels = c(
        "Kategoriespezifisches Encoder-Modell",
        "Kategoriespezifisches Encoder-Modell (Preprocessed)",
        "Kategoriespezifisches Encoder-Modell (Chunked)"
      )
    ) |>
      fct_rev(),
    Textart = factor(
      Textart,
      levels = c("Gesamt", "Facebook-Post", "Tweet", "Zeitungsartikel")
    ),
    type = if_else(
      str_detect(Methode, "Modell"),
      "LLM-basierte Verfahren",
      "Vergleichsverfahren"
    )
  ) |>
  select(-name)

plot_data |>
  rename_with(~ str_replace(.x, "f_meas", "f1"), matches("f_meas")) |>
  rename_with(
    ~ str_replace(.x, "kripp_alpha", "Krippendorff's Alpha"),
    matches("kripp_alpha")
  ) |>
  pivot_longer(
    accuracy_point:`Krippendorff's Alpha_upper`,
    names_to = c("measure", "point"),
    names_sep = "_",
    values_to = "value"
  ) |>
  pivot_wider(names_from = point, values_from = value) |>
  mutate(
    measure = measure |>
      str_to_title() |>
      str_replace("Alpha", "α") |>
      as_factor() |>
      fct_relevel("Krippendorff's α", "Accuracy", "Precision", "Recall", "F1"),
  ) |>
  ggplot(aes(
    x = point,
    xmin = lower,
    xmax = upper,
    y = Methode,
    color = Textart
  )) +
  geom_pointrange(position = position_dodge(.5)) +
  scale_x_continuous(
    breaks = c(0, .5, 1),
    minor_breaks = c(.25, .75),
    limits = c(-.2, 1)
  ) +
  xlab("") +
  ylab("") +
  scale_color_manual(
    values = c("#3f2d54", "#d1897570", "#8fd17570", "#75b8d170")
  ) +
  facet_grid(
    ~type ~ measure,
    scales = "free_y",
    space = "free_y"
  ) +
  theme(
    legend.position = "bottom"
  )
1
Vorbereitung der Plot-Daten: Laden aller Validierungsmetriken für verschiedene Textarten, Umbenennung der Methoden zu lesbaren Labels, Faktorisierung für richtige Reihenfolge und Kategorisierung in LLM-basierte vs. Vergleichsverfahren.
2
Erstellung des Validierungs-Plots: Umstrukturierung der Daten für ggplot, Umbenennung der Metriken, Erstellung eines Point-Range-Plots mit Konfidenzintervallen, farbkodiert nach Textarten und facettiert nach Verfahrenstyp und Metriken.