1 Präregistrierung (VOR Analyse festlegen)

Wichtig: Dieser Abschnitt ist als Prä-Registrierung formuliert (Hypothesen + Zielkorridore), d.h. vor dem Blick auf die Ergebnisse festlegen.

1.1 1) Messmodell / Skalen

Wir arbeiten mit einer 7-Faktoren-Lösung (Agentischer Narzissmus als Facettenmodell).

Geplante Auswertung (Skalenbildung): - Primär: Faktorscores aus EFA (7 Faktoren; psych::fa, Rotation oblimin, scores = "regression"). - Optional (falls vorhanden): Skalenmittelwerte aus präregistrierten Items je Faktor (einsetzen in prereg_items unten).

# OPTIONAL: Wenn ihr bereits feste Itemlisten pro Faktor habt, hier einsetzen (Spaltennamen aus dem Datensatz).
# Beispiel:
# prereg_items <- list(
#   PA1 = c("N1","N5","N13"),
#   PA2 = c("N2","N9","N21")
# )

prereg_items <- NULL  # <- so lassen, wenn ihr (noch) keine festen Itemlisten einsetzen wollt

faktor_namen <- c(
  PA1 = "Agentischer Narzissmus",
  PA2 = "Anerkennungsbestreben",
  PA3 = "Selbstwertgefühl",
  PA4 = "Soziale Dominanz",
  PA5 = "Kompetenz",
  PA6 = "Bewunderungsbestreben",
  PA7 = "Anspruchsdenken"
)

1.2 2) Nomologisches Netz: erwartete konvergente / diskriminante Zusammenhänge

Wir prüfen Validität über Korrelationen zu: - Soziale Erwünschtheit (SD): als methoden-/bias-nahe Variable (diskriminant: eher klein) - NOTE: Kriteriumsvalidität (kleine bis moderate Effekte erwartet; Richtung faktorabhängig) - Interkorrelationen der Faktoren/Skalen: Evidenz für diskriminante Validität (nicht zu hoch)

1.2.1 Zielkorridore (Hypothesen)

Konvergent = theoretisch naheliegend (z.B. Zusammenhänge zwischen inhaltlich nahen Facetten bzw. zu passenden Kriterien). Diskriminant = sollte gering sein (z.B. SD).

Hinweis: Korridore sind bewusst als Intervalle formuliert (statt exakter r-Werte), weil Stichproben-/Messfehler und Skalenlänge Effekte schwanken lassen.

# Zielkorridore als Tabelle
# r_min / r_max = erwarteter Bereich der Korrelation (Pearson r)

corridors <- tribble(
  ~Faktor, ~Konstrukt, ~r_min, ~r_max, ~Art,

  # Diskriminante Validität (Methoden-/Bias-Variable)
  "PA1", "SD",   -0.15,  0.20, "diskriminant",
  "PA2", "SD",    0.00,  0.30, "sekundär (Impression)",
  "PA3", "SD",   -0.15,  0.20, "diskriminant",
  "PA4", "SD",   -0.15,  0.20, "diskriminant",
  "PA5", "SD",   -0.15,  0.20, "diskriminant",
  "PA6", "SD",    0.00,  0.30, "sekundär (Impression)",
  "PA7", "SD",   -0.20,  0.15, "diskriminant",

  # Kriteriumsvalidität (NOTE) – Richtung/Größe faktorabhängig (kleine bis moderate Effekte)
  "PA1", "NOTE", -0.15,  0.15, "kriterium",
  "PA2", "NOTE", -0.15,  0.15, "kriterium",
  "PA3", "NOTE", -0.10,  0.20, "kriterium",
  "PA4", "NOTE", -0.20,  0.10, "kriterium",
  "PA5", "NOTE",  0.05,  0.30, "kriterium (Leistung)",
  "PA6", "NOTE", -0.15,  0.15, "kriterium",
  "PA7", "NOTE", -0.25,  0.05, "kriterium"
)


corridors %>%
  mutate(Faktor = paste0(Faktor, " – ", faktor_namen[Faktor])) %>%
  kable(digits = 2, caption = "Präregistrierte Zielkorridore (Pearson r)") %>%
  kable_styling(full_width = FALSE)
Präregistrierte Zielkorridore (Pearson r)
Faktor Konstrukt r_min r_max Art
PA1 – Agentischer Narzissmus SD -0.15 0.20 diskriminant
PA2 – Anerkennungsbestreben SD 0.00 0.30 sekundär (Impression)
PA3 – Selbstwertgefühl SD -0.15 0.20 diskriminant
PA4 – Soziale Dominanz SD -0.15 0.20 diskriminant
PA5 – Kompetenz SD -0.15 0.20 diskriminant
PA6 – Bewunderungsbestreben SD 0.00 0.30 sekundär (Impression)
PA7 – Anspruchsdenken SD -0.20 0.15 diskriminant
PA1 – Agentischer Narzissmus NOTE -0.15 0.15 kriterium
PA2 – Anerkennungsbestreben NOTE -0.15 0.15 kriterium
PA3 – Selbstwertgefühl NOTE -0.10 0.20 kriterium
PA4 – Soziale Dominanz NOTE -0.20 0.10 kriterium
PA5 – Kompetenz NOTE 0.05 0.30 kriterium (Leistung)
PA6 – Bewunderungsbestreben NOTE -0.15 0.15 kriterium
PA7 – Anspruchsdenken NOTE -0.25 0.05 kriterium

2 Daten & Vorbereitung

# Daten einlesen (Semikolon-getrennt)
this_file <- knitr::current_input()
this_dir <- if(!is.null(this_file) && nzchar(this_file)) dirname(this_file) else getwd()

# Datei robust finden (arbeitet mit relativem Pfad; Standard über YAML-Parameter)
data_file <- if(!is.null(params$data_file) && nzchar(params$data_file)) params$data_file else "Daten_Narzismuss_inklNote.csv"

locate_file <- function(f) {
  if (is.null(f) || !nzchar(f)) return(NA_character_)
  # wenn absoluter Pfad angegeben wurde:
  if (file.exists(f)) return(f)
  # Suchpfade: Rmd-Ordner, Working Directory, Unterordner "data", Elternordner
  candidates <- unique(c(
    file.path(this_dir, f),
    file.path(getwd(), f),
    file.path(getwd(), "data", f),
    file.path(this_dir, "data", f),
    file.path(dirname(this_dir), f),
    f
  ))
  hit <- candidates[file.exists(candidates)][1]
  if (!is.na(hit)) return(hit)
  NA_character_
}

data_path <- locate_file(data_file)

if (is.na(data_path)) {
  stop(paste0(
    "Daten-Datei nicht gefunden. Gesucht nach: ", data_file, "\n",
    "Arbeitsverzeichnis (getwd): ", getwd(), "\n",
    "Rmd-Ordner (this_dir): ", this_dir, "\n",
    "Tipp: Lege die CSV in denselben Ordner wie das Rmd ODER setze in der YAML unter params$data_file einen korrekten (relativen oder absoluten) Pfad."
  ))
}

message("Lese Daten aus: ", normalizePath(data_path, winslash = "/"))
dat <- read.csv2(data_path, stringsAsFactors = FALSE)

# Hilfsfunktion: Reverse bei 1..4 Likert
rev_1to4 <- function(x) { ifelse(is.na(x), NA, 5 - x) }

# --- Soziale Erwünschtheit (SD) ---
sd_cols <- names(dat)[startsWith(names(dat), "SD_")]
if(length(sd_cols) > 0){
  sd_rev <- sd_cols[str_detect(sd_cols, "\\.$")]  # Spaltennamen mit Punkt am Ende als "umgepolt"
  dat <- dat %>%
    mutate(across(all_of(sd_rev), rev_1to4, .names = "{.col}_R"))

  # Arbeitsvektor: Punkt entfernen; bei *_R Version verwenden
  sd_work <- sapply(sd_cols, function(nm){
    if(str_detect(nm, "\\.$")) paste0(nm, "_R") else nm
  })
  dat <- dat %>%
    mutate(SD = rowMeans(across(all_of(sd_work)), na.rm = TRUE))
} else {
  dat$SD <- NA_real_
}

# --- Agentischer Narzissmus Itempool ---
n_cols <- names(dat)[str_detect(names(dat), "^N\\d+$")]
stopifnot(length(n_cols) > 0)

# NOTE prüfen
if(!("NOTE" %in% names(dat))) dat$NOTE <- NA_real_

2.1 Deskriptive Kennwerte (Kurzcheck)

dat %>%
  select(SD, NOTE) %>%
  psych::describe() %>%
  as.data.frame() %>%
  tibble::rownames_to_column("Variable") %>%
  kable(digits = 2, caption = "Deskriptive Statistiken (SD, NOTE)") %>%
  kable_styling(full_width = FALSE)
Deskriptive Statistiken (SD, NOTE)
Variable vars n mean sd median trimmed mad min max range skew kurtosis se
SD 1 420 2.63 0.19 2.64 2.63 0.21 2.07 3.12 1.04 -0.22 -0.32 0.01
NOTE 2 80 1.80 0.76 1.60 1.71 0.59 1.00 6.00 5.00 2.32 9.62 0.08

3 EFA (7 Faktoren) & Skalenbildung

# Itemmatrix (N1..N*)
X <- dat %>% select(all_of(n_cols))

# EFA: 7 Faktoren, oblimin (korrelierte Faktoren)
# vollständige Fälle für Faktorscores (sonst passen Zeilen nicht zusammen)
cc <- complete.cases(X)

fa7 <- psych::fa(X[cc, ], nfactors = 7, rotate = "oblimin", fm = "minres", scores = "regression")

fa7
## Factor Analysis using method =  minres
## Call: psych::fa(r = X[cc, ], nfactors = 7, rotate = "oblimin", scores = "regression", 
##     fm = "minres")
## Standardized loadings (pattern matrix) based upon correlation matrix
##       MR1   MR4   MR2   MR6   MR3   MR7   MR5   h2   u2 com
## N1   0.68 -0.02 -0.03  0.12  0.01  0.02 -0.02 0.55 0.45 1.1
## N2   0.06  0.26  0.46  0.02 -0.13  0.05  0.19 0.38 0.62 2.3
## N3   0.16  0.11  0.06  0.06 -0.07  0.41 -0.08 0.33 0.67 1.7
## N4  -0.08  0.10 -0.01 -0.03 -0.65  0.03  0.06 0.45 0.55 1.1
## N5  -0.18  0.55 -0.02  0.26  0.09  0.08  0.07 0.42 0.58 1.8
## N6   0.02  0.15  0.03 -0.01  0.66 -0.06 -0.02 0.43 0.57 1.1
## N7  -0.05  0.18  0.00 -0.66 -0.09 -0.07  0.00 0.45 0.55 1.2
## N8   0.12  0.39  0.30 -0.03 -0.14 -0.16  0.10 0.32 0.68 3.0
## N9   0.29  0.18 -0.10  0.09  0.14  0.08 -0.04 0.24 0.76 3.0
## N10  0.18  0.28 -0.55 -0.08 -0.08 -0.15  0.14 0.43 0.57 2.2
## N11  0.35  0.25  0.01  0.04  0.11 -0.05  0.08 0.27 0.73 2.3
## N12  0.26  0.08 -0.02  0.58  0.00 -0.13 -0.12 0.58 0.42 1.6
## N13 -0.08 -0.10  0.09  0.11  0.42  0.00  0.06 0.22 0.78 1.5
## N14  0.07  0.10 -0.64 -0.07  0.02  0.01  0.04 0.41 0.59 1.1
## N15  0.11  0.10 -0.02  0.05 -0.05  0.35 -0.02 0.21 0.79 1.5
## N16 -0.01  0.04  0.05  0.84  0.01 -0.02  0.06 0.71 0.29 1.0
## N17  0.15  0.26  0.27 -0.05 -0.14 -0.06  0.00 0.22 0.78 3.3
## N18  0.13  0.47 -0.20  0.04  0.15  0.20  0.13 0.48 0.52 2.4
## N19 -0.01  0.00  0.62  0.05  0.05  0.14  0.00 0.41 0.59 1.1
## N20  0.12  0.05  0.10 -0.12 -0.22  0.37 -0.28 0.35 0.65 3.3
## N21 -0.46  0.13  0.04 -0.13  0.17  0.00 -0.05 0.26 0.74 1.7
## N22 -0.13  0.05 -0.11 -0.24  0.04 -0.09  0.35 0.27 0.73 2.6
## N23  0.14  0.53 -0.07 -0.07  0.00  0.12  0.02 0.39 0.61 1.3
## N24  0.03  0.49  0.01  0.02 -0.15 -0.17 -0.02 0.28 0.72 1.5
## N25  0.11 -0.07  0.16  0.08 -0.02  0.35 -0.01 0.20 0.80 1.9
## N26  0.25  0.25 -0.09  0.16  0.23  0.07  0.09 0.35 0.65 4.5
## N27  0.47 -0.02  0.18 -0.03  0.14  0.12 -0.10 0.33 0.67 1.8
## N28 -0.02  0.23 -0.12  0.18  0.05  0.24  0.26 0.30 0.70 4.3
## N29  0.07  0.16  0.09  0.06 -0.22  0.14 -0.28 0.27 0.73 3.7
## N30  0.21  0.01 -0.23  0.14  0.12  0.22  0.19 0.28 0.72 5.1
## N31  0.12  0.11  0.03  0.70 -0.05  0.00  0.07 0.64 0.36 1.1
## N32  0.10 -0.06 -0.06 -0.03 -0.61  0.04  0.12 0.36 0.64 1.2
## N33  0.13  0.30 -0.02  0.17  0.02  0.08 -0.37 0.38 0.62 2.8
## N34  0.06 -0.09  0.60 -0.24  0.17 -0.08  0.04 0.47 0.53 1.6
## N35  0.00  0.55 -0.09  0.12  0.03  0.12 -0.12 0.43 0.57 1.4
## N36  0.07  0.01 -0.68 -0.16  0.06  0.17  0.03 0.48 0.52 1.3
## N37 -0.07  0.30  0.03  0.16  0.01  0.15  0.40 0.33 0.67 2.7
## N38  0.01  0.50 -0.10  0.09 -0.11  0.01 -0.09 0.34 0.66 1.3
## N39 -0.02  0.00  0.02 -0.74  0.05  0.00  0.12 0.58 0.42 1.1
## N40  0.16  0.07  0.11 -0.04 -0.19 -0.12  0.05 0.09 0.91 4.0
## N41  0.02  0.57  0.07  0.09  0.07  0.07 -0.11 0.42 0.58 1.2
## N42  0.55 -0.20 -0.13  0.14  0.12 -0.10  0.24 0.41 0.59 2.2
## N43  0.56  0.01  0.01  0.27 -0.01  0.09 -0.05 0.57 0.43 1.5
## N44 -0.07 -0.10 -0.08  0.02 -0.30  0.34 -0.09 0.20 0.80 2.6
## N45 -0.02  0.01 -0.06  0.42  0.19  0.35  0.18 0.44 0.56 2.9
## N46  0.07  0.16  0.20  0.01 -0.26  0.16 -0.07 0.24 0.76 3.9
## N47  0.09  0.08  0.31  0.03 -0.16  0.00 -0.25 0.25 0.75 2.9
## N48  0.15 -0.06  0.08  0.03  0.09  0.27  0.22 0.18 0.82 3.2
## N49  0.22 -0.15  0.33 -0.09  0.12  0.21  0.14 0.26 0.74 4.1
## N50  0.13  0.21  0.51 -0.03 -0.16  0.04  0.21 0.43 0.57 2.2
## N51  0.12  0.37  0.09  0.17 -0.02  0.06  0.15 0.32 0.68 2.3
## N52  0.41  0.10  0.30  0.03 -0.04  0.11 -0.04 0.39 0.61 2.2
## N53  0.00  0.02  0.67  0.00  0.11  0.04 -0.14 0.49 0.51 1.2
## N54  0.04  0.07  0.06 -0.05  0.64  0.06  0.25 0.51 0.49 1.4
## N55  0.28  0.21  0.07  0.15 -0.18  0.05 -0.10 0.32 0.68 3.9
## N56  0.39  0.07  0.07 -0.15  0.05  0.23 -0.03 0.26 0.74 2.2
## N57  0.13  0.35 -0.05  0.15  0.11  0.11 -0.41 0.46 0.54 2.9
## N58  0.32  0.16  0.06  0.04  0.07  0.18  0.13 0.29 0.71 2.8
## N59  0.07 -0.04  0.63 -0.08  0.02  0.04  0.11 0.43 0.57 1.1
## N60  0.44  0.20  0.02  0.08  0.01  0.18  0.02 0.44 0.56 1.9
## N61  0.16  0.31  0.00  0.44 -0.02 -0.02 -0.06 0.51 0.49 2.2
## N62  0.29  0.24  0.01  0.04 -0.18  0.18  0.04 0.34 0.66 3.6
## N63  0.61  0.10 -0.05  0.17 -0.06 -0.03 -0.17 0.58 0.42 1.4
## N64  0.05  0.03  0.00  0.00  0.64 -0.04 -0.10 0.41 0.59 1.1
## N65 -0.01 -0.15 -0.34  0.01  0.21  0.28  0.13 0.29 0.71 3.4
## N66  0.39  0.06  0.20 -0.10  0.12  0.08 -0.29 0.34 0.66 3.0
## N67  0.04  0.23 -0.22  0.17  0.03  0.20  0.25 0.32 0.68 4.8
## N68  0.07  0.20  0.06  0.13 -0.35  0.05 -0.07 0.27 0.73 2.3
## N69  0.01  0.11  0.05 -0.09 -0.31  0.53 -0.03 0.45 0.55 1.8
## N70  0.16  0.24  0.31 -0.07 -0.30  0.09  0.15 0.37 0.63 4.3
## 
##                        MR1  MR4  MR2  MR6  MR3  MR7  MR5
## SS loadings           4.69 4.60 4.53 4.42 3.58 2.47 1.80
## Proportion Var        0.07 0.07 0.06 0.06 0.05 0.04 0.03
## Cumulative Var        0.07 0.13 0.20 0.26 0.31 0.35 0.37
## Proportion Explained  0.18 0.18 0.17 0.17 0.14 0.09 0.07
## Cumulative Proportion 0.18 0.36 0.53 0.70 0.84 0.93 1.00
## 
##  With factor correlations of 
##       MR1   MR4   MR2   MR6   MR3   MR7   MR5
## MR1  1.00  0.36  0.11  0.42  0.01  0.27 -0.04
## MR4  0.36  1.00  0.02  0.35 -0.14  0.28  0.01
## MR2  0.11  0.02  1.00 -0.09 -0.10  0.06 -0.10
## MR6  0.42  0.35 -0.09  1.00  0.08  0.18 -0.05
## MR3  0.01 -0.14 -0.10  0.08  1.00 -0.03  0.13
## MR7  0.27  0.28  0.06  0.18 -0.03  1.00  0.04
## MR5 -0.04  0.01 -0.10 -0.05  0.13  0.04  1.00
## 
## Mean item complexity =  2.3
## Test of the hypothesis that 7 factors are sufficient.
## 
## df null model =  2415  with the objective function =  30.1 with Chi Square =  11494.1
## df of  the model are 1946  and the objective function was  8.54 
## 
## The root mean square of the residuals (RMSR) is  0.04 
## The df corrected root mean square of the residuals is  0.04 
## 
## The harmonic n.obs is  407 with the empirical chi square  2771.27  with prob <  4.6e-32 
## The total n.obs was  407  with Likelihood Chi Square =  3221.36  with prob <  2.2e-66 
## 
## Tucker Lewis Index of factoring reliability =  0.823
## RMSEA index =  0.04  and the 90 % confidence intervals are  0.038 0.043
## BIC =  -8471.79
## Fit based upon off diagonal values = 0.96
## Measures of factor score adequacy             
##                                                    MR1  MR4  MR2  MR6  MR3  MR7
## Correlation of (regression) scores with factors   0.93 0.93 0.94 0.95 0.92 0.87
## Multiple R square of scores with factors          0.87 0.86 0.88 0.90 0.85 0.75
## Minimum correlation of possible factor scores     0.73 0.72 0.77 0.79 0.70 0.51
##                                                    MR5
## Correlation of (regression) scores with factors   0.86
## Multiple R square of scores with factors          0.74
## Minimum correlation of possible factor scores     0.47
# Ladungen (nur > |.30|)
print(fa7$loadings, cutoff = 0.30, sort = TRUE)
## 
## Loadings:
##     MR1    MR4    MR2    MR6    MR3    MR7    MR5   
## N1   0.681                                          
## N42  0.553                                          
## N43  0.556                                          
## N63  0.608                                          
## N5          0.549                                   
## N23         0.533                                   
## N35         0.549                                   
## N38         0.502                                   
## N41         0.566                                   
## N10               -0.555                            
## N14               -0.640                            
## N19                0.621                            
## N34                0.601                            
## N36               -0.680                            
## N50                0.509                            
## N53                0.673                            
## N59                0.633                            
## N7                       -0.664                     
## N12                       0.581                     
## N16                       0.837                     
## N31                       0.701                     
## N39                      -0.735                     
## N4                              -0.647              
## N6                               0.663              
## N32                             -0.606              
## N54                              0.643              
## N64                              0.642              
## N69                             -0.312  0.533       
## N2                 0.459                            
## N3                                      0.410       
## N8          0.392  0.300                            
## N9                                                  
## N11  0.351                                          
## N13                              0.422              
## N15                                     0.346       
## N17                                                 
## N18         0.473                                   
## N20                                     0.374       
## N21 -0.463                                          
## N22                                            0.351
## N24         0.492                                   
## N25                                     0.355       
## N26                                                 
## N27  0.465                                          
## N28                                                 
## N29                                                 
## N30                                                 
## N33                                           -0.372
## N37                                            0.395
## N40                                                 
## N44                             -0.304  0.342       
## N45                       0.419         0.347       
## N46                                                 
## N47                0.309                            
## N48                                                 
## N49                0.333                            
## N51         0.370                                   
## N52  0.407         0.303                            
## N55                                                 
## N56  0.391                                          
## N57         0.355                             -0.411
## N58  0.324                                          
## N60  0.436                                          
## N61         0.310         0.442                     
## N62                                                 
## N65               -0.344                            
## N66  0.394                                          
## N67                                                 
## N68                             -0.347              
## N70                0.307        -0.304              
## 
##                  MR1   MR4   MR2   MR6   MR3   MR7   MR5
## SS loadings    3.727 3.768 4.405 3.682 3.465 2.024 1.734
## Proportion Var 0.053 0.054 0.063 0.053 0.050 0.029 0.025
## Cumulative Var 0.053 0.107 0.170 0.223 0.272 0.301 0.326

3.1 Faktorscores (für Validität)

scores_cc <- as.data.frame(fa7$scores)
names(scores_cc) <- paste0("F", seq_len(ncol(scores_cc)))

# Scores auf volle Datenlänge auffüllen (NA für Fälle mit Missing in N-Items)
scores_full <- as.data.frame(matrix(NA_real_, nrow = nrow(dat), ncol = ncol(scores_cc)))
names(scores_full) <- names(scores_cc)
scores_full[cc, ] <- as.matrix(scores_cc)

dat <- bind_cols(dat, scores_full)

# Wenn ihr feste Itemlisten habt, zusätzlich Skalenmittelwerte berechnen:
if(!is.null(prereg_items)){
  for(nm in names(prereg_items)){
    cols <- prereg_items[[nm]]
    cols <- cols[cols %in% names(dat)]
    dat[[nm]] <- rowMeans(dat[, cols, drop = FALSE], na.rm = TRUE)
  }
}

4 Validitätsanalyse

4.1 Konvergente & diskriminante Validität (Korrelationen)

# Welche Faktorvariablen verwenden?
faktor_vars <- if(!is.null(prereg_items) && length(prereg_items) > 0) names(prereg_items) else paste0("F", 1:7)

# Korrelationen mit SD und NOTE
extern <- c("SD","NOTE")
df_corr <- dat %>%
  select(all_of(c(faktor_vars, extern)))

ct <- psych::corr.test(df_corr, use = "pairwise", adjust = "holm")

# Extrahiere nur Faktor x Extern
R <- ct$r[faktor_vars, extern, drop = FALSE]
P_raw <- ct$p[faktor_vars, extern, drop = FALSE]

R_df <- as.data.frame(R) %>% tibble::rownames_to_column("Faktor") %>%
  pivot_longer(-Faktor, names_to = "Konstrukt", values_to = "r")

P_df <- as.data.frame(P_raw) %>% tibble::rownames_to_column("Faktor") %>%
  pivot_longer(-Faktor, names_to = "Konstrukt", values_to = "p")

out <- left_join(R_df, P_df, by = c("Faktor", "Konstrukt")) %>%
  mutate(
    # Holm-Korrektur über alle in dieser Tabelle berichteten Tests
    p_holm = p.adjust(p, method = "holm"),
    sig = case_when(
      p_holm < .001 ~ "***",
      p_holm < .01  ~ "**",
      p_holm < .05  ~ "*",
      TRUE          ~ ""
    )
  )

out %>%
  mutate(cell = paste0(sprintf("%.2f", r), sig)) %>%
  select(Faktor, Konstrukt, cell) %>%
  pivot_wider(names_from = Konstrukt, values_from = cell) %>%
  kable(caption = "Korrelationen Faktor/Skalen × externe Variablen (Holm-korrigiert; Sternchen = Signifikanz)") %>%
  kableExtra::kable_styling(full_width = FALSE)
Korrelationen Faktor/Skalen × externe Variablen (Holm-korrigiert; Sternchen = Signifikanz)
Faktor SD NOTE
F1 -0.32*** -0.07
F2 -0.40*** -0.06
F3 -0.09 -0.16
F4 -0.22** 0.04
F5 0.14 -0.16
F6 -0.41*** -0.10
F7 0.10 -0.05

4.2 Abgleich mit den präregistrierten Zielkorridoren

# Abgleich der beobachteten Korrelationen mit präregistrierten Zielkorridoren
# Hinweis: Die Zielkorridore sind für PA1..PA7 definiert.
# Wenn in der Korrelationstabelle EFA-Scores F1..F7 verwendet werden, mappen wir standardmäßig:
#   F1 -> PA1, F2 -> PA2, ..., F7 -> PA7
# (Das ist eine pragmatische Zuordnung nach Faktor-Reihenfolge; ggf. im Text kurz begründen.)

obs <- out %>% select(Faktor, Konstrukt, r) %>%
  mutate(
    Faktor_mapped = case_when(
      # Falls schon PA1..PA7
      Faktor %in% corridors$Faktor ~ Faktor,
      # Falls EFA-Faktoren F1..F7: Mapping nach Nummer
      grepl("^F[0-9]+$", Faktor) ~ paste0("PA", sub("^F", "", Faktor)),
      TRUE ~ Faktor
    )
  )

check <- obs %>%
  left_join(corridors, by = c("Faktor_mapped" = "Faktor", "Konstrukt")) %>%
  mutate(
    verdict = case_when(
      is.na(r_min) | is.na(r_max) ~ "kein Korridor hinterlegt",
      r < r_min ~ "unter Erwartung",
      r > r_max ~ "über Erwartung",
      TRUE ~ "im Korridor"
    )
  ) %>%
  arrange(Faktor_mapped, Faktor, Konstrukt)

check %>%
  mutate(
    Faktor = ifelse(Faktor == Faktor_mapped, Faktor,
                    paste0(Faktor, " (→ ", Faktor_mapped, ")"))
  ) %>%
  select(Faktor, Konstrukt, r, r_min, r_max, Art, verdict) %>%
  kable(digits = 2, caption = "Abgleich: beobachtete Korrelationen vs. präregistrierte Zielkorridore") %>%
  kableExtra::kable_styling(full_width = FALSE)
Abgleich: beobachtete Korrelationen vs. präregistrierte Zielkorridore
Faktor Konstrukt r r_min r_max Art verdict
F1 (→ PA1) NOTE -0.07 -0.15 0.15 kriterium im Korridor
F1 (→ PA1) SD -0.32 -0.15 0.20 diskriminant unter Erwartung
F2 (→ PA2) NOTE -0.06 -0.15 0.15 kriterium im Korridor
F2 (→ PA2) SD -0.40 0.00 0.30 sekundär (Impression) unter Erwartung
F3 (→ PA3) NOTE -0.16 -0.10 0.20 kriterium unter Erwartung
F3 (→ PA3) SD -0.09 -0.15 0.20 diskriminant im Korridor
F4 (→ PA4) NOTE 0.04 -0.20 0.10 kriterium im Korridor
F4 (→ PA4) SD -0.22 -0.15 0.20 diskriminant unter Erwartung
F5 (→ PA5) NOTE -0.16 0.05 0.30 kriterium (Leistung) unter Erwartung
F5 (→ PA5) SD 0.14 -0.15 0.20 diskriminant im Korridor
F6 (→ PA6) NOTE -0.10 -0.15 0.15 kriterium im Korridor
F6 (→ PA6) SD -0.41 0.00 0.30 sekundär (Impression) unter Erwartung
F7 (→ PA7) NOTE -0.05 -0.25 0.05 kriterium im Korridor
F7 (→ PA7) SD 0.10 -0.20 0.15 diskriminant im Korridor

4.3 Diskriminante Validität innerhalb des Tests (Faktorinterkorrelationen)

df_f <- dat %>% select(all_of(faktor_vars))

R_f <- cor(df_f, use="pairwise.complete.obs")
kable(round(R_f, 2), caption = "Interkorrelationen der Faktoren/Skalen") %>%
  kable_styling(full_width = FALSE)
Interkorrelationen der Faktoren/Skalen
F1 F2 F3 F4 F5 F6 F7
F1 1.00 0.43 0.14 0.49 0.01 0.36 -0.07
F2 0.43 1.00 0.02 0.41 -0.17 0.37 0.00
F3 0.14 0.02 1.00 -0.10 -0.12 0.08 -0.14
F4 0.49 0.41 -0.10 1.00 0.09 0.22 -0.06
F5 0.01 -0.17 -0.12 0.09 1.00 -0.05 0.17
F6 0.36 0.37 0.08 0.22 -0.05 1.00 0.06
F7 -0.07 0.00 -0.14 -0.06 0.17 0.06 1.00

5 Kriteriumsvalidität (NOTE)

if("NOTE" %in% names(dat)){
  res_note <- out %>%
    filter(Konstrukt == "NOTE") %>%
    arrange(desc(abs(r)))
  res_note %>%
    kable(digits = 3, caption = "Kriteriumsvalidität: Korrelationen mit NOTE") %>%
    kable_styling(full_width = FALSE)
} else {
  cat("Keine NOTE-Variable im Datensatz gefunden.")
}
Kriteriumsvalidität: Korrelationen mit NOTE
Faktor Konstrukt r p p_holm sig
F3 NOTE -0.161 1 1
F5 NOTE -0.158 1 1
F6 NOTE -0.095 1 1
F1 NOTE -0.072 1 1
F2 NOTE -0.063 1 1
F7 NOTE -0.048 1 1
F4 NOTE 0.043 1 1

6 Multi-Trait-Multi-Method (MTMM) – Einordnung

In einem klassischen MTMM-Design braucht man mehrere Traits (hier: 7 Faktoren) und mehrere Methoden (z.B. Selbstbericht, Fremdbericht, Verhaltensmaß).
In unserem Datensatz liegen überwiegend Selbstberichte vor (Agentischer Narzissmus + SD; NOTE als Kriterium/Outcome). Dadurch ist nur eine eingeschränkte MTMM-Interpretation möglich (Multi-Trait, single method).

Praktisch kann SD als Methoden-/Bias-indikator genutzt werden: Wenn SD stark mit euren Faktoren korreliert, könnte das auf Antworttendenzen (Impression Management/Akquieszenz) hinweisen.

7 Gesamtbewertung des Tests (Stärken/Schwächen)

Hier sollt ihr EFA + Reliabilität + Validität zusammenführen. Der Text ist als ausfüllbare Vorlage gedacht; ergänzt eure konkreten Werte/Interpretationen.

7.1 Stärken

  • Faktorstruktur: 7 Faktoren (EFA) mit inhaltlich interpretierbaren Ladungen; Rotation oblimin erlaubt korrelierte Facetten.
  • Ökonomisch vs. Bandbreite: Facettenmodell erlaubt differenzierte Interpretation (z.B. Dominanz vs. Kompetenz vs. Selbstwert).
  • Validität (wenn bestätigt): niedrige Zusammenhänge mit SD (diskriminant) und theoriekonsistente Zusammenhänge mit NOTE (Kriterium) sprechen für konstruktnahe Messung.

7.2 Schwächen / Limitationen

  • Präregistrierung & Itemselektion: Wenn Items nach Sichtung der Daten angepasst wurden, besteht Overfitting-Risiko; deshalb ideal: feste prereg-Listen + Replikation.
  • Reliabilität: kurze Skalen können niedrigere Alphas zeigen; wichtig ist auch Trennschärfe und Inhaltsvalidität.
  • MTMM: nur Selbstbericht → gemeinsame Methodenvarianz möglich; besser wäre zusätzlicher Fremdbericht/Verhaltenskriterium.
  • Kriteriumsvalidität (NOTE): Erwartbar eher klein; NOTE ist multifaktoriell (Fähigkeit, Motivation, Kontext), daher begrenzte Sensitivität für narzisstische Facetten.

7.3 Fazit

  • Wenn (a) Faktoren stabil, (b) Reliabilitäten akzeptabel und (c) Korrelationen weitgehend im Zielkorridor liegen, spricht das für brauchbare Konstruktvalidität der Skalen.
  • Abweichungen (z.B. hohe SD-Korrelationen oder unerwartete theoretisch entfernten Merkmalen-Muster) sollten als Hinweise auf Konstruktüberlappung, Itemformulierung oder Antworttendenzen diskutiert werden.