# --- LCA-Werkzeuge (Spezifikation wie im Original: poLCA, 9 -> Kategorie 6) ----
lca_daten <- function(items) {
neg <- intersect(items, items_negativ())
datensatz |>
select(all_of(items)) |>
mutate(across(all_of(neg), \(x) ifelse(x == 9, 9, 6 - x))) |> # erst drehen
mutate(across(everything(), \(x) ifelse(x == 9 | is.na(x), 6, x))) |> # dann 9 -> 6
mutate(across(everything(), as.integer))
}
lca_sequenz <- function(daten, kmax = 6, nrep = 10) {
f <- as.formula(paste0("cbind(", paste(names(daten), collapse = ", "), ") ~ 1"))
set.seed(1012) # wie im Original (01012)
map(seq_len(kmax), \(k) poLCA::poLCA(
f, daten, nclass = k, na.rm = FALSE,
nrep = nrep, maxiter = 3000, verbose = FALSE
))
}
lca_kennzahlen <- function(modelle) {
imap(modelle, \(m, k) {
n <- m$Nobs
tibble(
Klassen = k,
LogLik = m$llik,
BIC = m$bic,
cAIC = -2 * m$llik + m$npar * (1 + log(n)),
aBIC = -2 * m$llik + log((n + 2) / 24) * m$npar
)
}) |> list_rbind()
}
# Antwortprofile tidy: je Klasse/Item die Wahrscheinlichkeit gebündelter Kategorien
lca_profil <- function(modell) {
imap(modell$probs, \(p, item) {
df <- as_tibble(p, rownames = "klasse") |>
rename_with(\(x) sub("Pr\\((\\d)\\).*", "K\\1", x), starts_with("Pr"))
for (k in paste0("K", 1:6)) if (!k %in% names(df)) df[[k]] <- 0
df |> mutate(item = item, klasse = sub("class (\\d+): *", "\\1", klasse))
}) |>
list_rbind() |>
transmute(
item, klasse,
Zustimmung = K1 + K2,
`Teils/teils` = K3,
Ablehnung = K4 + K5,
`keine Angabe` = K6
)
}
# Klassen inhaltlich ordnen: 'Uninformierte' = hoher Anteil 'keine Angabe',
# Rest absteigend nach Zustimmung. Gibt Zuordnung klasse -> Label/Rang.
lca_ordnung <- function(modell, labels_pos_nach_neg, label_uninformiert = NULL) {
prof <- lca_profil(modell) |>
group_by(klasse) |>
summarise(zust = mean(Zustimmung), ka = mean(`keine Angabe`), .groups = "drop")
uninf <- character(0)
if (!is.null(label_uninformiert)) {
uninf <- prof |> slice_max(ka, n = 1) |> pull(klasse)
}
rest <- prof |> filter(!klasse %in% uninf) |> arrange(desc(zust)) |> pull(klasse)
tibble(
klasse = c(rest, uninf),
label = c(labels_pos_nach_neg[seq_along(rest)], label_uninformiert),
anteil = modell$P[as.integer(c(rest, uninf))]
)
}
# --- Moderne Visualisierungen --------------------------------------------------
farben_profil <- c(Zustimmung = "#2166ac", `Teils/teils` = "#c9c9c9",
Ablehnung = "#c14b3a", `keine Angabe` = "#8d8d8d")
plot_waffle <- function(ordnung, titel, farben) {
n100 <- round(ordnung$anteil * 100)
n100[1] <- 100 - sum(n100[-1]) # Rundung auf exakt 100 Personen
df <- tibble(label = factor(rep(ordnung$label, n100), levels = ordnung$label)) |>
mutate(pos = row_number() - 1, x = pos %% 10, y = pos %/% 10)
beschriftung <- ordnung |>
mutate(text = sprintf("%s: %.0f %%", label, 100 * anteil))
ggplot(df, aes(x, y, colour = label)) +
geom_point(size = 4.6) +
scale_colour_manual(values = farben,
labels = beschriftung$text, name = NULL) +
coord_equal() +
scale_y_reverse() +
labs(title = titel, subtitle = "Jeder Punkt steht für 1 von 100 Personen") +
theme_void(base_size = 12.5) +
theme(legend.position = "right",
plot.title = element_text(face = "bold"),
plot.subtitle = element_text(colour = "#6a7682", size = 10.5),
legend.text = element_text(size = 11))
}
plot_elbow <- function(kennzahlen, gewaehlt) {
df <- kennzahlen |>
select(Klassen, BIC, cAIC, aBIC) |>
pivot_longer(-Klassen, names_to = "Kriterium", values_to = "Wert")
enden <- df |> filter(Klassen == max(Klassen))
ggplot(df, aes(Klassen, Wert, colour = Kriterium)) +
geom_vline(xintercept = gewaehlt, colour = "#1a9850",
linetype = "dashed", linewidth = 0.6) +
geom_line(linewidth = 0.8) +
geom_point(size = 2.2) +
geom_text(data = enden, aes(label = Kriterium),
hjust = -0.15, size = 3.4, fontface = "bold") +
annotate("text", x = gewaehlt, y = max(df$Wert),
label = "gewählte Lösung", colour = "#1a9850",
hjust = -0.05, size = 3.4) +
scale_colour_manual(values = c(BIC = "#2c7fb8", cAIC = "#8856a7", aBIC = "#f0946c"),
guide = "none") +
scale_x_continuous(breaks = 1:6, limits = c(1, 7.1)) +
labs(x = "Anzahl Klassen", y = "Informationskriterium (kleiner = besser)") +
theme_diss(base_size = 11.5)
}
plot_profile <- function(modell, ordnung, item_texte = NULL) {
prof <- lca_profil(modell) |>
left_join(ordnung, by = "klasse") |>
mutate(
label = factor(sprintf("%s (%.0f %%)", label, 100 * anteil),
levels = sprintf("%s (%.0f %%)", ordnung$label, 100 * ordnung$anteil)),
item = factor(item, levels = rev(unique(item)))
) |>
pivot_longer(c(Zustimmung, `Teils/teils`, Ablehnung, `keine Angabe`),
names_to = "antwort", values_to = "p") |>
mutate(antwort = factor(antwort, levels = names(farben_profil)))
ggplot(prof, aes(x = p, y = item, fill = antwort)) +
geom_col(width = 0.75, colour = "white", linewidth = 0.3) +
facet_wrap(~label, nrow = 1) +
scale_fill_manual(values = farben_profil, name = NULL) +
scale_x_continuous(labels = \(x) paste0(100 * x, " %"), breaks = c(0, .5, 1)) +
labs(x = "Antwortwahrscheinlichkeit", y = NULL) +
theme_diss(base_size = 11) +
theme(legend.position = "top", legend.justification = "left",
panel.grid.major.y = element_blank(),
strip.text = element_text(size = 10))
}
# Drei Sequenzen à sechs Modelle (Achtung: einige Minuten Rechenzeit beim
# ersten Knitten; danach greift der Cache).
stopifnot(requireNamespace("poLCA", quietly = TRUE))
kwb_items <- c("F09_a", "F09_b", "F09_c", "F10_a", "F10_b", "F10_c", "F10_d", "F10_e")
wka_items <- paste0("F12_", letters[1:7])
bio_items <- paste0("F14_", letters[1:8])
seq_kwb <- lca_sequenz(lca_daten(kwb_items))
seq_wka <- lca_sequenz(lca_daten(wka_items))
seq_bio <- lca_sequenz(lca_daten(bio_items))
# Endmodelle mit nrep = 30 wie im Original nachschätzen
lca_final <- function(items, k) {
daten <- lca_daten(items)
f <- as.formula(paste0("cbind(", paste(names(daten), collapse = ", "), ") ~ 1"))
set.seed(1012)
poLCA::poLCA(f, daten, nclass = k, na.rm = FALSE,
nrep = 30, maxiter = 3000, verbose = FALSE)
}
lca_kwb <- lca_final(kwb_items, 3)
lca_wka <- lca_final(wka_items, 3)
lca_bio <- lca_final(bio_items, 4)
ord_kwb <- lca_ordnung(lca_kwb,
c("stark klimabewusst", "moderat klimabewusst", "distanziert/skeptisch"))
ord_wka <- lca_ordnung(lca_wka,
c("Befürworter", "bedingte moderate Befürworter", "Unüberzeugte"))
ord_bio <- lca_ordnung(lca_bio,
c("Befürworter", "Unentschiedene", "Gegner"), "Uninformierte")
Wie hoch ist eigentlich der Anteil der Klimabewussten in der Bevölkerung? Und wie steht es um die Akzeptanz von Windkraft- und Biogasanlagen in der Nordwestregion? Durchschnittswerte beantworten das nur halb — hinter einem Mittelwert von „stimme eher zu“ können sehr unterschiedliche Menschen stecken. Die latente Klassenanalyse sucht deshalb nach Gruppen mit ähnlichen Antwortmustern und zählt aus, wie groß diese Gruppen sind.
Die Bevölkerung der Nordwestregion zerfällt bei allen drei Themen in wenige, klar unterscheidbare Gruppen. Beim Klimawandelbewusstsein dominieren die bewussten Gruppen, eine distanzierte Minderheit bleibt. Windkraft hat eine breite Befürworter-Basis mit einem harten Kern und einem größeren „Ja, aber“-Lager; klare Gegner bilden keine eigene Gruppe. Bei Biogas fällt vor allem eines auf: Ein Viertel der Befragten antwortet überwiegend mit „weiß nicht“ — Biogas ist für viele schlicht Neuland.
Statt für jedes Item einen Durchschnitt zu bilden, sortiert die latente Klassenanalyse (LCA) Personen: Sie sucht Gruppen, deren Mitglieder über alle Items hinweg ähnlich antworten. Wie viele Gruppen die Daten hergeben, entscheiden statistische Kriterien (v.a. der BIC). Jede Person wird der Gruppe zugeordnet, zu der ihr Antwortmuster am besten passt. Ein Vorteil gegenüber den Strukturgleichungsmodellen: „Weiß nicht“ und fehlende Antworten fließen als eigene, inhaltlich bedeutsame Kategorie ein (Diss., Kap. 7.10.1).
Methodik in einem Satz: Für jedes Thema wurden sechs
Modelle mit 1–6 Klassen geschätzt (poLCA, je 30
Startwert-Wiederholungen gegen lokale Maxima), per Informationskriterien
verglichen und die sparsamste inhaltlich plausible Lösung gewählt — beim
Klimawandelbewusstsein und der Windkraftakzeptanz je drei Klassen, bei
Biogas vier (Diss., Kap. 7.11–7.13). Die Klassen werden hier anhand
ihrer Antwortprofile benannt und sortiert.
plot_waffle(ord_kwb, "Klimawandelbewusstsein: drei Gruppen",
c("stark klimabewusst" = "#2166ac",
"moderat klimabewusst" = "#7fb2d6",
"distanziert/skeptisch" = "#c14b3a"))
Klassenanteile der Dreiklassenlösung (geschätzte Populationsanteile). Diss.-Referenz (Kap. 7.11, Tab. 154): 15.1 %, 43.8 %, 41.2 %.
Die Gruppen unterscheiden sich vor allem im Handeln: Die stark Klimabewussten stimmen kognitiv, emotional und handlungsbezogen zu. Die moderate Gruppe erkennt den Klimawandel an und ist besorgt, wird bei den Handlungs-Items aber unentschieden. Die distanzierte Gruppe zeigt wenig Besorgnis und tendiert bei den kognitiven Items zur Skepsis (Diss., Kap. 7.11.1).
plot_profile(lca_kwb, ord_kwb)
Antwortprofile der drei Klassen: Wahrscheinlichkeit für Zustimmung (Kat. 1–2), Teils/teils, Ablehnung (Kat. 4–5) und „keine Angabe“ je Item. Items in KWB-Richtung gepolt.
plot_elbow(lca_kennzahlen(seq_kwb), gewaehlt = 3)
Modellwahl per Elbow-Plot: BIC und cAIC erreichen ihr Minimum bei drei Klassen (vgl. Diss., Abb. 58).
Hinweis zur Dissertation: In Kap. 7.11.2 sind die Klassenbezeichnungen gegenüber den Antwortprofilen (Tab. 155) und der Klassencharakterisierung vertauscht. Dieser Bericht benennt die Klassen konsequent nach ihren Antwortprofilen.
plot_waffle(ord_wka, "Windkraftakzeptanz: drei Gruppen",
c("Befürworter" = "#2166ac",
"bedingte moderate Befürworter" = "#7fb2d6",
"Unüberzeugte" = "#f0946c"))
Klassenanteile der Dreiklassenlösung. Diss.-Referenz (Kap. 7.12.2): Befürworter 35.4 %, bedingte moderate Befürworter 43.2 %, Unüberzeugte 21.4 %.
Bemerkenswert ist, was fehlt: Eine Klasse klarer Windkraft-Gegner findet sich nicht — auch nicht in der testweise ausgewerteten Vierklassenlösung. Die kritischste Gruppe ist „unüberzeugt“: unentschieden bei der Gesamtbewertung, skeptisch bei den Begleitfolgen. Zugleich zeigt sich in allen Gruppen die Diskrepanz zwischen hoher allgemeiner Zustimmung (F12_a, F12_b) und deutlich kritischerer Bewertung der konkreten Begleitfolgen (Strompreis, Landschaftsbild, Wohnnähe) — das „Ja, aber“ der Windkraftakzeptanz (Diss., Kap. 7.12).
plot_profile(lca_wka, ord_wka)
Antwortprofile der drei Klassen über die sieben Windkraft-Items (in Akzeptanzrichtung gepolt).
plot_elbow(lca_kennzahlen(seq_wka), gewaehlt = 3)
Modellwahl: BIC und cAIC präferieren die Dreiklassenlösung (vgl. Diss., Abb. 63).
plot_waffle(ord_bio, "Biogasakzeptanz: vier Gruppen",
c("Befürworter" = "#2166ac",
"Unentschiedene" = "#7fb2d6",
"Gegner" = "#c14b3a",
"Uninformierte" = "#8d8d8d"))
Klassenanteile der Vierklassenlösung. Diss.-Referenz (Kap. 7.13.2): Befürworter 41.5 %, Unentschiedene 19.8 %, Gegner 13.4 %, Uninformierte 25.4 %.
Bei Biogas leistet die LCA etwas, das die Strukturgleichungsmodelle nicht konnten: Die vielen „Weiß nicht“-Antworten werden nicht weggeworfen oder imputiert, sondern bilden eine eigene Gruppe — rund ein Viertel der Bevölkerung. Anders als bei Windkraft gibt es hier außerdem eine kleine, aber klar profilierte Gegner-Gruppe, die alle Items sehr negativ bewertet. Selbst bei den Uninformierten zeigt sich in der bilanzierenden Gesamtbewertung (F14_a, F14_b) eine positive Tendenz (Diss., Kap. 7.13.2).
plot_profile(lca_bio, ord_bio)
Antwortprofile der vier Klassen über die acht Biogas-Items (in Akzeptanzrichtung gepolt). Die Uninformierten sind an der grauen „keine Angabe“-Dominanz erkennbar.
plot_elbow(lca_kennzahlen(seq_bio), gewaehlt = 4)
Modellwahl: BIC präferiert vier Klassen; die Vierklassenlösung ist zudem inhaltlich plausibler (eigene „Weiß nicht“-Klasse) — vgl. Diss., Kap. 7.13.
Die latenten Klassenanalysen beantworten die Eingangsfragen mit klaren Gruppenbildern: Beim Klimawandelbewusstsein stehen einer stark und einer moderat klimabewussten Mehrheit rund 40 % Distanzierte gegenüber — getrennt weniger durch das Wissen als durch die Handlungsbereitschaft. Windkraft hat in der Nordwestregion eine breite Befürworter-Basis ohne profilierte Gegner-Gruppe; kritisch wird es bei den konkreten Begleitfolgen. Bei Biogas ist die auffälligste Gruppe die der Uninformierten — ein Viertel der Bevölkerung hat sich schlicht noch kein Urteil gebildet. Für Praxis und Kommunikation heißt das: Information wirkt bei Biogas, Beteiligung und Begleitfolgen-Debatte bei Windkraft (Diss., Kap. 7.11–7.13).
datensatz (n = 577) aus dem
klimawandelbewusstsein-Paket; Items rekodiert, „9“ (weiß
nicht/fehlend) als Kategorie 6 — exakt wie im Original
(9-6 latente Klassenanalyse/Endmodelle/LCA-Auswertung - USETHIS.R).poLCA,
na.rm = FALSE, maxiter = 3000, Sequenzen mit
nrep = 10 (Elbow) bzw. nrep = 30 (Endmodelle),
set.seed(1012).si <- sessionInfo()
tibble(Paket = names(si$otherPkgs),
Version = vapply(si$otherPkgs, \(p) as.character(p$Version), "")) |>
arrange(Paket) |>
tab(caption = paste("Geladene Pakete unter", si$R.version$version.string))
| Paket | Version |
|---|---|
| dplyr | 1.1.4 |
| ggplot2 | 4.0.3 |
| klimawandelbewusstsein | 1.0.0 |
| knitr | 1.45 |
| purrr | 1.0.2 |
| testthat | 3.2.1 |
| tidyr | 1.3.0 |