Validierung

Beispielstudie

Zur Beurteilung der Leistungsfähigkeit (Prüfung der Validität) oder zur Kontrastierung mit anderen Verfahren (Vergleich) müssen die Codierergebnisse mit dem Goldstandard verglichen werden. Verschiedene Validitätsmaße können hierfür herangezogen werden: Accuracy gibt den Prozentsatz der Übereinstimmung zwischen dem Goldstandard und der jeweiligen Codierung an (vgl. Scharkow, 2012, S. 136). Krippendorff’s α berücksichtigt zusätzlich, wie viele Übereinstimmungen durch Zufall zustande gekommen wären (vgl. Krippendorff, 2004b, S. 414–415). Precision, Recall und F1 beziehen sich jeweils auf die einzelnen Ausprägungen (d. h., “positiv”, “negativ” oder “neutral”) und wurden hier makro-gemittelt, d. h., Precision, Recall und F1 wurden jeweils über alle drei Ausprägungen hinweg gemittelt, ohne Berücksichtigung der Häufigkeit der Ausprägungen. Precision gibt an, welcher Anteil der Texte, die vom Verfahren einer bestimmten Ausprägung zugeordnet wurden, diese Ausprägung tatsächlich laut Goldstandard aufweisen (d. h., wie ‘sauber’ die Codierungen sind, Scharkow, 2012, S. 136). Recall gibt an, welcher Anteil der Texte, die laut Goldstandard eine spezifische Ausprägung aufweisen, erkannt wurde (d. h., wie ‘vollständig’ die Codierungen sind, Scharkow, 2012). F1 ist das harmonische Mittel aus Precision und Recall (Scharkow, 2012).

Einlesen der Daten

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

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

aufgabenspezifisches_encoder_modell <-
  read_csv(here::here(

    "beispielstudie/data/02_aufgabenspezifisches_Encoder-Modell.csv"
  )) |>
  mutate(

    id = id,
    sentiment_aufgabenspezifisches_encoder_modell = case_when(

      pmax(neutral, positiv, negativ) == neutral ~ "neutral",
      pmax(neutral, positiv, negativ) == positiv ~ "positiv",
      pmax(neutral, positiv, negativ) == negativ ~ "negativ"
    ),
    .keep = "none"
  )

universelles_decoder_modell <-
  read_csv(here::here(

    "beispielstudie/data/03_universelles_Decoder-Modell.csv"
  )) |>
  mutate(

    id = id,
    sentiment_universelles_decoder_modell = sentiment,
    .keep = "none"
  )

diktionaerbasierte_codierung <-
  read_csv(here::here("beispielstudie/data/05_diktionaer.csv")) |>
  mutate(

    id = id,
    sentiment_diktionaerbasierte_codierung = case_when(

      sentiment == -1 ~ "negativ",
      sentiment == 0 ~ "neutral",
      sentiment == 1 ~ "positiv"
    ),
    .keep = "none"
  )

ml_codierung <-
  bind_rows(

    read_csv(here::here(

      "beispielstudie/data/06_ueberwachtes_maschinelles_Lernen_Facebook.csv"
    )),
    read_csv(here::here(

      "beispielstudie/data/06_ueberwachtes_maschinelles_Lernen_Twitter.csv"
    )),
    read_csv(here::here(

      "beispielstudie/data/06_ueberwachtes_maschinelles_Lernen_Zeitungsartikel.csv"
    ))
  ) |>
  mutate(

    id = id,
    sentiment_nb = case_when(

      sentiment_nb == -1 ~ "negativ",
      sentiment_nb == 0 ~ "neutral",
      sentiment_nb == 1 ~ "positiv"
    ),
    sentiment_svm = case_when(

      sentiment_svm == -1 ~ "negativ",
      sentiment_svm == 0 ~ "neutral",
      sentiment_svm == 1 ~ "positiv"
    ),
    .keep = "none"
  )

validierung <-
  gold |>
  left_join(kategoriespezifisches_encoder_modell, by = "id") |>
  left_join(aufgabenspezifisches_encoder_modell, by = "id") |>
  left_join(universelles_decoder_modell, by = "id") |>
  left_join(diktionaerbasierte_codierung, by = "id") |>
  left_join(ml_codierung, by = "id") |>
  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 aufgabenspezifischen Encoder-Modell Ergebnisse und Bestimmung der vorhergesagten Kategorie basierend auf den höchsten Wahrscheinlichkeitswerten.

5

Laden der universellen Decoder-Modell Ergebnisse (bereits in korrektem Format).

6

Laden der diktionärbasierten Codierung und Konvertierung der numerischen Werte zu kategorialen Labels.

7

Laden aller maschinellen Lernergebnisse (Facebook, Twitter, Zeitungsartikel), Zusammenführung und Konvertierung der numerischen Werte zu kategorialen Labels für beide ML-Methoden.

8

Zusammenführung aller Datensätze zu einem Validierungsdatensatz und Konvertierung aller Variablen zu Faktoren.

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.

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_aufgabenspezifisches_encoder_modell = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_aufgabenspezifisches_encoder_modell"
              )),
              sentiment_universelles_decoder_modell = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_universelles_decoder_modell"
              )),
              sentiment_diktionaerbasierte_codierung = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_diktionaerbasierte_codierung"
              )),
              sentiment_nb = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_nb"
              )),
              sentiment_svm = list(calculate_vali_metrics(
                data = .,
                var = "sentiment_svm"
              ))
            ) |>
            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/07_vali_metrics_complete.csv"))
) {
  set.seed(42)
  validierung |>
    bootstrap_vali_metrics(times = 2000) |>
    write_csv(here::here("beispielstudie/data/07_vali_metrics_complete.csv"))
}

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

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

if (
  !file.exists(here::here(
    "beispielstudie/data/07_vali_metrics_zeitungsartikel.csv"
  ))
) {
  set.seed(42)
  validierung |>
    filter(textart == "Zeitungsartikel") |>
    bootstrap_vali_metrics(times = 2000) |>
    write_csv(here::here(
      "beispielstudie/data/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.

R

plot_data <-
  bind_rows(
    read_csv(here::here("beispielstudie/data/07_vali_metrics_complete.csv")) |>
      mutate(Textart = "Gesamt"),
    read_csv(here::here("beispielstudie/data/07_vali_metrics_facebook.csv")) |>
      mutate(Textart = "Facebook-Post"),
    read_csv(here::here("beispielstudie/data/07_vali_metrics_twitter.csv")) |>
      mutate(Textart = "Tweet"),
    read_csv(here::here(
      "beispielstudie/data/07_vali_metrics_zeitungsartikel.csv"
    )) |>
      mutate(Textart = "Zeitungsartikel")
  ) |>
  mutate(
    Methode = case_when(
      name == "sentiment_kategoriespezifisches_encoder_modell" ~
        "Kategoriespezifisches\nEncoder-Modell",
      name == "sentiment_aufgabenspezifisches_encoder_modell" ~
        "Aufgabenspezifisches\nEncoder-Modell",
      name == "sentiment_universelles_decoder_modell" ~
        "Universelles\nDecoder-Modell",
      name == "sentiment_diktionaerbasierte_codierung" ~
        "Diktionärsbasierte\nCodierung",
      name == "sentiment_nb" ~ "Naive\nBayes",
      name == "sentiment_svm" ~ "Support Vector\nMachine"
    ),
    Methode = factor(
      Methode,
      levels = c(
        "Kategoriespezifisches\nEncoder-Modell",
        "Aufgabenspezifisches\nEncoder-Modell",
        "Universelles\nDecoder-Modell",
        "Diktionärsbasierte\nCodierung",
        "Naive\nBayes",
        "Support Vector\nMachine"
      )
    ) |>
      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.

Die Abbildung illustriert die Prüfung der Validität sowie den Methodenvergleich hinsichtlich der beispielhaft gewählten AIA-Verfahren. Im Hinblick auf die Validität der drei LLM-basierten Verfahren ließe sich in diesem Beispiel eine gemischte Bilanz ziehen: Die Übereinstimmungen der Modell-Codierungen mit dem Goldstandard lagen auf moderatem Niveau, unterschritten aber in einigen Fällen den kritischen Grenzwert von Krippendorff’s α = .667 (vgl. Krippendorff, 2004a, S. 242). Die per Bootstrapping berechneten 95-%-Konfidenzintervalle (2.000 Bootstrap-Resamples) legen nahe, dass sich die Kennwerte größtenteils nicht signifikant zwischen den Modellen unterscheiden, vermutlich aufgrund der geringen Stichprobengröße. Allerdings erreichte das kategoriespezifische Encoder-Modell eine signifikant schlechtere Leistung als die anderen beiden LLM-basierten Verfahren. Im Rahmen des Methodenvergleichs lassen sich ebenfalls kaum signifikante Unterschiede ausmachen. Zumindest deskriptiv lagen das aufgabenspezifische Encoder-Modell und das universelle Decoder-Modell aber oberhalb der anderen AIA-Verfahren.

Ergänzende Validierung

Hier finden Sie außerdem eine umfängliche Validierung der Klassifikationen des kategoriespezifischen Encoder-Modells. Wir vergleichen dabei das Verfahren mit Kürzung langer Texte (also quasi “off the shelf”, wie im Paper berichtet) mit der komplexeren Anwendung inkl. Preprocessing bzw. Aufteilung langer Texte (siehe unterschiedliche Verfahren hier).

Literatur

Krippendorff, K. (2004a). Content Analysis: An Introduction to Its Methodology (2nd edition). Sage Publ.

Krippendorff, K. (2004b). Reliability in Content Analysis: Some Common Misconceptions and Recommendations. Human Communication Research, 30(3), 411–433. https://doi.org/10.1111/j.1468-2958.2004.tb00738.x

Scharkow, M. (2012). Automatische Inhaltsanalyse und maschinelles Lernen. epubli.