1 Pakete & Daten

library(openxlsx)
library(psych)
library(knitr)

stopifnot(file.exists("data_agentnarc.xlsx"))
stopifnot(file.exists("Codebook_agentnarc.xlsx"))

data_agentnarc <- openxlsx::read.xlsx("data_agentnarc.xlsx")
Codebook <- openxlsx::read.xlsx("Codebook_agentnarc.xlsx")

# Spaltennamen im Codebook säubern (Trailing spaces entfernen)
names(Codebook) <- trimws(names(Codebook))

2 Präregistrierung

2.1 Analyseplan (vorab festgelegt)

Wir schätzen die Reliabilität für 7 Faktoren mittels Cronbachs Alpha mit
psych::alpha(x, check.keys = TRUE), wobei x jeweils das Itemset eines Faktors enthält.

Umgang mit Missing Values: Listwise-Deletion pro Faktor (nur Fälle mit vollständigen Antworten auf die Items des jeweiligen Faktors).

Item-Entscheidungsregeln (vorab):
Wir entfernen Items nur bei klaren Problemen und nicht allein für minimale Alpha-Gewinne. Entscheidungen berücksichtigen stets

Inhaltsvalidität (Lage im nomologischen Netzwerk),
Messziel (passt das Item wirklich zum Konstrukt?),
Schwierigkeit (z. B. extreme Zustimmung/Ablehnung → geringe Varianz),
Trennschärfe (korrigierte Item-Total-Korrelation; r.drop).

A-priori Kriterien, ab wann Items als Kandidaten gelten:

Harte Kriterien (starker Kandidat):
- r.drop < 0 (Hinweis auf falsche Polung/inkonsistentes Item)
- sehr geringe Streuung (Faustregel bei Likert): sd < 0.70
Weiche Kriterien (prüfen, inhaltlich abwägen):
- r.drop < .20 → stark prüfen / häufig entfernen
- .20 ≤ r.drop < .30 → „borderline“ (nur entfernen, wenn Inhaltsvalidität nicht leidet)
- Alpha-Anstieg beim Löschen: Δα ≥ .02 (sonst kein Entfernen nur wegen Alpha)

Wenn Items entfernt werden: Alpha wird neu geschätzt und die Entscheidung wird inhaltlich begründet (nicht rein statistisch).

2.2 Präregistrierte Faktor–Item-Zuordnung

# Faktoren: Itemlisten (vorab festgelegt)
faktoren <- list(
  PA1 = c("agent_4D_2", "agent_4C_2", "agent_5A_5", "agent_5E_3", "agent_3E_2"),
  PA2 = c("agent_5C_2", "agent_5C_4", "agent_2A_5", "agent_5D_3", "agent_5E_1", "agent_4B_4", "agent_2A_2"),
  PA3 = c("agent_4A_1", "agent_4A_3", "agent_3D_2", "agent_3E_1", "agent_1D_4", "agent_2D_1", "agent_2D_2", "agent_3B_2"),
  PA4 = c("agent_2D_3", "agent_3D_1", "agent_2B_1", "agent_1C_4", "agent_1B_5", "agent_3C_1", "agent_2A_3", "agent_1D_1", "agent_5B_3"),
  PA5 = c("agent_5A_2", "agent_1C_3", "agent_4D_3", "agent_3A_2", "agent_3A_3", "agent_4C_3", "agent_5B_2"),
  PA6 = c("agent_1C_1", "agent_2B_3", "agent_1D_5", "agent_2E_1", "agent_1B_3", "agent_2B_4"),
  PA7 = c("agent_2A_4", "agent_2E_3", "agent_1A_5", "agent_2D_4", "agent_5A_5")
)

# Optional: Klartexte für Faktoren (anpassen, falls ihr andere Bezeichnungen habt)
faktor_namen <- c(
  PA1 = "Agentischer Narzissmus",
  PA2 = "Anerkennungsbestreben",
  PA3 = "Selbstwertgefühl",
  PA4 = "Soziale Dominanz",
  PA5 = "Kompetenzerleben",
  PA6 = "Bewunderungsbestreben",
  PA7 = "Anspruchsdenken"
)

# Konsistenzchecks
alle_items <- unlist(faktoren, use.names = FALSE)
dups <- unique(alle_items[duplicated(alle_items)])
if (length(dups) > 0) {
  message("Hinweis: Folgende Items kommen in mehr als einem Faktor vor: ",
          paste(dups, collapse = ", "))
}

2.2.1 PA1 (Agentischer Narzissmus)

Items: agent_4D_2, agent_4C_2, agent_5A_5, agent_5E_3, agent_3E_2

2.2.2 PA2 (Anerkennungsbestreben)

Items: agent_5C_2, agent_5C_4, agent_2A_5, agent_5D_3, agent_5E_1, agent_4B_4, agent_2A_2

2.2.3 PA3 (Selbstwertgefühl)

Items: agent_4A_1, agent_4A_3, agent_3D_2, agent_3E_1, agent_1D_4, agent_2D_1, agent_2D_2, agent_3B_2

2.2.4 PA4 (Soziale Dominanz)

Items: agent_2D_3, agent_3D_1, agent_2B_1, agent_1C_4, agent_1B_5, agent_3C_1, agent_2A_3, agent_1D_1, agent_5B_3

2.2.5 PA5 (Kompetenzerleben)

Items: agent_5A_2, agent_1C_3, agent_4D_3, agent_3A_2, agent_3A_3, agent_4C_3, agent_5B_2

2.2.6 PA6 (Bewunderungsbestreben)

Items: agent_1C_1, agent_2B_3, agent_1D_5, agent_2E_1, agent_1B_3, agent_2B_4

2.2.7 PA7 (Anspruchsdenken)

Items: agent_2A_4, agent_2E_3, agent_1A_5, agent_2D_4, agent_5A_5

Optional (hilfreich für Inhaltsvalidität): Itemtexte aus dem Codebook für die präregistrierten Items.

2.2.7.1 Itemtexte – PA1 (Agentischer Narzissmus)

Präregistrierte Items: PA1 – Agentischer Narzissmus
	Itemname	Itemtext	Kernkonstrukt	recoded
225	agent_4D_2	Ich verdiene eine bevorzugte Behandlung.	nein	nein
222	agent_4C_2	Ich sollte stets im Mittelpunkt stehen.	nein	nein
248	agent_5A_5	Ich habe eine besondere Behandlung verdient.	nein	nein
257	agent_5E_3	Ich sollte im Mittelpunkt stehen, weil ich ein besonderer Mensch bin.	ja	nein
210	agent_3E_2	In einer Gruppe bin ich immer der interessanteste Mensch.	ja	nein

2.2.7.2 Itemtexte – PA2 (Anerkennungsbestreben)

Präregistrierte Items: PA2 – Anerkennungsbestreben
	Itemname	Itemtext	Kernkonstrukt	recoded
229	agent_5C_2	Ich genieße die Anerkennung und Bewunderung anderer.	ja	nein
231	agent_5C_4	Ich erzähle anderen gern von meinen Erfolgen.	ja	nein
187	agent_2A_5	Ich genieße es, wenn andere mich für meine Leistungen bewundern.	ja	nein
235	agent_5D_3	Es ist mir wichtig, bewusst einen Eindruck zu hinterlassen, der meinen Erfolg und meine Kompetenz zeigt.	ja	nein
255	agent_5E_1	Ich möchte, dass andere meine besonderen Fähigkeiten anerkennen und bewundern.	ja	nein
219	agent_4B_4	Mir ist es wichtig, dass meine besonderen Fähigkeiten gesehen und angemessen anerkannt werden.	ja	nein
184	agent_2A_2	Es stört mich extrem, wenn meine Leistungen von anderen nicht bemerkt und anerkannt werden.	ja	nein

2.2.7.3 Itemtexte – PA3 (Selbstwertgefühl)

Präregistrierte Items: PA3 – Selbstwertgefühl
	Itemname	Itemtext	Kernkonstrukt	recoded
212	agent_4A_1	Ich bin großartig, so wie ich bin.	ja	nein
214	agent_4A_3	Ich werde von meinen Mitmenschen bewundert.	ja	nein
207	agent_3D_2	Menschen sind von mir beeindruckt.	nein	nein
209	agent_3E_1	Ich bin bewundernswert.	ja	nein
153	agent_1D_4	Andere Menschen wollen so sein wie ich.	ja	nein
189	agent_2D_1	Ich bin außergewöhnlich.	ja	nein
190	agent_2D_2	Zu wissen, dass ich etwas Besonderes bin, gibt mir viel Kraft.	ja	nein
198	agent_3B_2	Ich hinterlasse durch meine herausragenden Leistungen Eindruck bei anderen.	ja	nein

2.2.7.4 Itemtexte – PA4 (Soziale Dominanz)

Präregistrierte Items: PA4 – Soziale Dominanz
	Itemname	Itemtext	Kernkonstrukt	recoded
191	agent_2D_3	Ich bin die Person, die bei Teamarbeiten die Führung übernehmen sollte.	ja	nein
206	agent_3D_1	In Gruppen übernehme ich selbstverständlich die Führung, weil ich am besten dafür geeignet bin.	nein	nein
178	agent_2B_1	Ich sollte in Gruppen die Leitung übernehmen, weil ich am geeignetsten bin.	ja	nein
148	agent_1C_4	Es ist am besten für alle, wenn ich die Führung bei schwierigen Entscheidungen übernehme.	Ja	Nein
171	agent_1B_5	In Gruppenkontexten werden die besten Ergebnisse erzielt, wenn ich die führende Rolle übernehme.	nein	nein
203	agent_3C_1	Ich halte es für selbstverständlich, dass ich in Gruppen die Führung übernehme.	nein	nein
185	agent_2A_3	Ich übernehme oft die Führung, weil ich befürchte, dass wir ohne mich scheitern.	ja	nein
150	agent_1D_1	Ich bin überzeugt, dass ich als Führungskraft anderen überlegen bin.	ja	nein
252	agent_5B_3	Ich übernehme gerne die Kontrolle und treffe Entscheidungen eigenständig.	ja	nein

2.2.7.5 Itemtexte – PA5 (Kompetenzerleben)

Präregistrierte Items: PA5 – Kompetenzerleben
	Itemname	Itemtext	Kernkonstrukt	recoded
245	agent_5A_2	Ich bin weitaus kompetenter als der Durchschnittsmensch.	nein	nein
147	agent_1C_3	Ich bin überzeugt, dass ich kompetenter als die meisten anderen Menschen bin.	Ja	Nein
226	agent_4D_3	Ich bin talentierter als meine Mitmenschen.	ja	nein
195	agent_3A_2	Ich bin intelligenter als alle anderen.	ja	nein
196	agent_3A_3	Meine Meinung ist meistens besser als die Meinung anderer.	ja	nein
223	agent_4C_3	Ich bin besser geeignet als andere, um schwierige Aufgaben zu lösen.	ja	nein
251	agent_5B_2	Ich halte mich für intelligent.	nein	nein

2.2.7.6 Itemtexte – PA6 (Bewunderungsbestreben)

Präregistrierte Items: PA6 – Bewunderungsbestreben
	Itemname	Itemtext	Kernkonstrukt	recoded
145	agent_1C_1	Mir ist es wichtig, von anderen bewundert zu werden.	Ja	Nein
180	agent_2B_3	Es ist mir wichtig, dass andere Menschen mich bewundern.	ja	nein
154	agent_1D_5	Ich strebe aktiv nach Bewunderung.	ja	nein
172	agent_2E_1	Ich strebe danach, dass Andere mich positiv bewerten.	ja	nein
169	agent_1B_3	Ich strebe aktiv danach, in jeder Situation stark bewundert zu werden.	nein	nein
181	agent_2B_4	Ich begebe mich gezielt in soziale Situationen, um mich positiv hervorzutun.	ja	nein

2.2.7.7 Itemtexte – PA7 (Anspruchsdenken)

Präregistrierte Items: PA7 – Anspruchsdenken
	Itemname	Itemtext	Kernkonstrukt	recoded
186	agent_2A_4	Ich habe das Gefühle, mir steht mehr zu als ich bekomme.	ja	nein
174	agent_2E_3	Ich habe das Gefühl, mir steht mehr zu, als ich bekomme.	ja	nein
160	agent_1A_5	Ich empfinde es als unfair wenn Leute meine Leistungen nicht anerkennen oder mit Neid oder Distanz reagieren, da mir die Bewunderung und Anerkennung zusteht.	ja	nein
192	agent_2D_4	Meine Leistungen rechtfertigen Respekt und Anerkennung von anderen Personen.	ja	nein
248	agent_5A_5	Ich habe eine besondere Behandlung verdient.	nein	nein

3 Reliabilität (Cronbachs Alpha)

# Hilfsfunktion: sichere Item-Auswahl
select_items <- function(dat, items) {
  missing <- setdiff(items, names(dat))
  if (length(missing) > 0) {
    stop("Diese Items wurden in den Daten nicht gefunden: ", paste(missing, collapse = ", "))
  }
  dat[, items, drop = FALSE]
}

# Hilfsfunktion: Alpha + Itemtabellen (inkl. Entscheidungsmarker)
run_alpha <- function(dat, items, codebook = NULL,
                      rdrop_border = .30, rdrop_hard = .20,
                      delta_alpha_cut = .02, sd_cut = .70,
                      mean_floor = 1.5, mean_ceiling = 5.5) {

  x <- select_items(dat, items)

  # sicherstellen, dass alles numerisch ist
  x[] <- lapply(x, function(v) as.numeric(v))

  # Listwise pro Faktor
  x_cc <- x[complete.cases(x), , drop = FALSE]

  a <- psych::alpha(x_cc, check.keys = TRUE)

  # Summary
  out <- list(
    k = ncol(x_cc),
    n = nrow(x_cc),
    alpha_raw = unname(a$total$raw_alpha),
    alpha_std = unname(a$total$std.alpha),
    average_r = unname(a$total$average_r),
    alpha_object = a
  )

  # Item-Stats
  item_stats <- a$item.stats
  item_stats$item <- rownames(item_stats)

  alpha_drop <- a$alpha.drop
  alpha_drop$item <- rownames(alpha_drop)

  # Wichtige Spalten rausziehen (robust)
  # raw_alpha beim Löschen heißt in psych::alpha i. d. R. "raw_alpha"
  keep_drop_cols <- intersect(c("item", "raw_alpha", "std.alpha"), names(alpha_drop))
  alpha_drop_small <- alpha_drop[, keep_drop_cols, drop = FALSE]
  names(alpha_drop_small) <- sub("^raw_alpha$", "alpha_if_deleted", names(alpha_drop_small))

  tab <- merge(item_stats, alpha_drop_small, by = "item", all.x = TRUE, sort = FALSE)
  tab$delta_alpha <- tab$alpha_if_deleted - out$alpha_raw

  # Inhaltsinfos aus Codebook ergänzen
  if (!is.null(codebook)) {
    cb <- codebook
    names(cb) <- trimws(names(cb))
    # robuste Spaltennamen
    cb2 <- cb[, intersect(c("Itemname", "Itemtext", "erwartete Schwierigkeit (psychologisch)", "Kernkonstrukt", "Überlappendes Konstrukt", "recoded"), names(cb)), drop = FALSE]
    names(cb2) <- make.names(names(cb2), unique = TRUE)
    names(cb2)[names(cb2) == "Itemname"] <- "item"
    tab <- merge(tab, cb2, by = "item", all.x = TRUE, sort = FALSE)
  }

  # Marker/Flags nach Präregistrierung
  tab$flag_rdrop_neg <- tab$r.drop < 0
  tab$flag_low_sd    <- tab$sd < sd_cut
  tab$flag_low_rdrop <- tab$r.drop < rdrop_hard
  tab$flag_border    <- tab$r.drop >= rdrop_hard & tab$r.drop < rdrop_border
  tab$flag_delta_a   <- tab$delta_alpha >= delta_alpha_cut
  tab$flag_floorceil <- (tab$mean < mean_floor) | (tab$mean > mean_ceiling)

  tab$entscheidung <- with(tab, ifelse(
    flag_rdrop_neg, "ENTFERNEN (r.drop < 0)",
    ifelse(flag_low_rdrop | flag_low_sd, "PRÜFEN/ENTFERNEN (niedrige Trennschärfe/Varianz)",
           ifelse(flag_delta_a | flag_border | flag_floorceil, "PRÜFEN (inhaltlich abwägen)",
                  "BEHALTEN"))
  ))

  # Ordnung wie Itemliste
  tab <- tab[match(items, tab$item), ]
  rownames(tab) <- NULL

  out$item_table <- tab
  out
}

3.1 Ergebnisse: Übersicht (7 Faktoren)

Reliabilität pro Faktor (Cronbachs Alpha)
Faktor	Skala	k	n	alpha_raw	alpha_std	average_r
PA1	Agentischer Narzissmus	5	367	0.894	0.897	0.634
PA2	Anerkennungsbestreben	7	367	0.878	0.879	0.508
PA3	Selbstwertgefühl	8	366	0.869	0.872	0.461
PA4	Soziale Dominanz	9	362	0.927	0.928	0.588
PA5	Kompetenzerleben	7	368	0.899	0.897	0.555
PA6	Bewunderungsbestreben	6	371	0.876	0.875	0.539
PA7	Anspruchsdenken	5	369	0.842	0.846	0.524

3.2 Ergebnisse: Itemdiagnostik pro Faktor

3.2.1 PA1 – Agentischer Narzissmus

Items: agent_4D_2, agent_4C_2, agent_5A_5, agent_5E_3, agent_3E_2

Cronbachs α (raw): 0.894
Cronbachs α (standardisiert): 0.897
k: 5, n (listwise): 367, Ø Inter-Item r: 0.634

Itemdiagnostik – PA1 (Agentischer Narzissmus)
item	Itemtext	mean	sd	r.drop	alpha_if_deleted	delta_alpha	entscheidung
agent_4D_2	Ich verdiene eine bevorzugte Behandlung.	1.757	0.919	0.794	0.861	-0.034	BEHALTEN
agent_4C_2	Ich sollte stets im Mittelpunkt stehen.	1.668	0.895	0.753	0.870	-0.025	BEHALTEN
agent_5A_5	Ich habe eine besondere Behandlung verdient.	1.886	0.985	0.735	0.873	-0.022	BEHALTEN
agent_5E_3	Ich sollte im Mittelpunkt stehen, weil ich ein besonderer Mensch bin.	2.074	1.044	0.799	0.858	-0.037	BEHALTEN
agent_3E_2	In einer Gruppe bin ich immer der interessanteste Mensch.	2.131	1.042	0.641	0.895	0.001	BEHALTEN