Fundamenty-moralne/przygotuj_dane.R

# Przygotowanie danych do analiz projektu moralnosci
#
library(dplyr)
# Skrypt:
# 1. czyta surowe dane ankietowe,
# 2. czyta wyniki eksperymentu karcianego,
# 3. laczy zbiory po kodzie uczestnika,
# 4. przelicza zmienne skalowe opisane w pliku JSON,
# 5. zapisuje gotowe pliki CSV w katalogu outputs/.
#
# Uruchomienie z katalogu analiza-md:
# Rscript przygotuj_dane.R

args <- commandArgs(trailingOnly = FALSE)
file_arg <- grep("^--file=", args, value = TRUE)
base_dir <- if (length(file_arg) > 0) {
  dirname(normalizePath(sub("^--file=", "", file_arg[1])))
} else {
  getwd()
}

path <- function(...) file.path(base_dir, ...)

survey_file <- path("dane/badanie_18_wyniki_20260519_192209.csv")
experiment_file <- path("dane/Plan badania kartami(Wyniki gry).csv")
json_file <- path("dane/badanie_18_pytania_20260514_212146.json")
output_dir <- path("outputs")

dir.create(output_dir, showWarnings = FALSE)

clean_code <- function(x) {
  x <- tolower(trimws(as.character(x)))
  gsub("\\s+", "", x)
}

to_num <- function(x) {
  x <- trimws(as.character(x))
  x[x %in% c("", "NA", "NaN")] <- NA
  x[x %in% c("Brak", "brak", "-", "brak danych")] <- NA
  suppressWarnings(as.numeric(gsub(",", ".", x, fixed = TRUE)))
}

row_mean <- function(data, vars) {
  out <- rowMeans(data[, vars, drop = FALSE], na.rm = TRUE)
  out[is.nan(out)] <- NA_real_
  out
}

row_sum <- function(data, vars) {
  out <- rowSums(data[, vars, drop = FALSE], na.rm = TRUE)
  all_missing <- rowSums(!is.na(data[, vars, drop = FALSE])) == 0
  out[all_missing] <- NA_real_
  out
}

rev_score <- function(x, max_value) {
  ifelse(is.na(x), NA_real_, max_value + 1 - x)
}

survey <- read.csv2(
  survey_file,
  stringsAsFactors = FALSE,
  check.names = FALSE,
  fileEncoding = "UTF-8-BOM",
  na.strings = c("", "NA")
)

head(survey)
colnames(survey)

# Nazwy ponizej odpowiadaja kolejnosci pytan opisanej w pliku JSON.
short_names <- c(
  "kod_dostepu",
  "data_zakonczenia",
  "zgoda_stacjonarna",
  "kod_uczestnika",
  "plec",
  "kierunek",
  "wiek",
  "rodzenstwo",
  # numeracja z oryginalnych skal, niektóre skale zastosowano krótsze
  paste0("mfq_zn_", c(1, 2, 3, 4, 6, 13, 12, 11, 10, 9, 8)),
  paste0("mfq_oc_", c(16, 17, 18, 19, 21, 22, 23, 24, 26, 27, 28, 29)),
  # klucz:
  # Troska/krzywda 1,6,11,16,21,26
  # Sprawiedliwość/oszustwo 2,7,12,17,22,27
  # Lojalność/zdrada 3,8,13,18,23,28
  # Autorytet/kwestionowanie władzy 4,9,14,19,24,29
  paste0("aprobata_", c(1, 3, 8, 23, 11, 13, 14, 16, 20, 22)),
  # klucz: 1P, 2F, 3F, 4P, 5F, 6P, 7F, 8P, 9F, 10P, 11P, 12F, 13F, 14P, 15P, 16P, 17P, 18F, 19P, 20P, 21P, 22F, 23F, 24P, 25F, 26P, 27F, 28F, 29P
  paste0("neuro_", 1:12),
  # odwrócone 1, 4, 7 ,10
  paste0("prospol_", 1:8)
)

names(survey)[seq_along(short_names)] <- short_names

# usuwanie kolumn mierzących czas
time_cols <- grepl(" - Czas \\[s\\]$", names(survey))
survey <- survey[, !time_cols, drop = FALSE]

# poprawianie kodów
survey$kod_uczestnika_clean <- clean_code(survey$kod_uczestnika)
survey$kierunek_clean <- tolower(trimws(survey$kierunek))
survey$wiek <- to_num(survey$wiek)

# rodzenstwo na cyfry
rodzenstwo_txt <- trimws(as.character(survey$rodzenstwo))
rodzenstwo_txt[tolower(rodzenstwo_txt) == "brak"] <- "0"
survey$rodzenstwo <- to_num(rodzenstwo_txt)

# płeć na kategorie
survey$plec_etykieta <- ifelse(
  survey$plec == 1, "kobieta",
  ifelse(survey$plec == 2, "osoba niebinarna",
    ifelse(survey$plec == 3, "mezczyzna",
      ifelse(survey$plec == 4, "inna", NA)
    )
  )
)

# dodatkowo kierunek
survey$kierunek_grupa <- ifelse(
  grepl("psycholog", survey$kierunek_clean), "psychologia",
  ifelse(grepl("kognity", survey$kierunek_clean), "kognitywistyka",
    ifelse(is.na(survey$kierunek_clean) | survey$kierunek_clean %in% c("", "-", "brak"), NA, "inny")
  )
)

scale_vars <- c(
  paste0("mfq_zn_", c(1, 2, 3, 4, 6, 13, 12, 11, 10, 9, 8)),
  paste0("mfq_oc_", c(16, 17, 18, 19, 21, 22, 23, 24, 26, 27, 28, 29)),
  paste0("aprobata_", c(1, 3, 8, 23, 11, 13, 14, 16, 20, 22)),
  paste0("neuro_", 1:12),
  paste0("prospol_", 1:8)
)

for (v in scale_vars) {
  survey[[v]] <- to_num(survey[[v]])
}

# Moral Foundations Questionnaire: indeksy wedlug oryginalnej numeracji itemow.
survey$MFQ_TROSKA <- row_mean(survey, c("mfq_zn_1", "mfq_zn_6", "mfq_zn_11", "mfq_oc_16", "mfq_oc_21", "mfq_oc_26"))
survey$MFQ_SPRAWIEDLIWOSC <- row_mean(survey, c("mfq_zn_2", "mfq_zn_12", "mfq_oc_17", "mfq_oc_22", "mfq_oc_27"))
survey$MFQ_LOJALNOSC <- row_mean(survey, c("mfq_zn_3", "mfq_zn_8", "mfq_zn_13", "mfq_oc_18", "mfq_oc_23", "mfq_oc_28"))
survey$MFQ_AUTORYTET <- row_mean(survey, c("mfq_zn_4", "mfq_zn_9", "mfq_oc_19", "mfq_oc_24", "mfq_oc_29"))


# Aprobata spoleczna: wynik dla dostepnych itemow wedlug klucza P/F.
aprobata_items <- c(1, 3, 8, 23, 11, 13, 14, 16, 20, 22)
aprobata_scores <- data.frame(matrix(NA_real_, nrow = nrow(survey), ncol = length(aprobata_items)))
names(aprobata_scores) <- paste0("aprobata_score_", aprobata_items)

positive_true <- c(1, 8, 11, 14, 16, 20)
negative_false <- c(3, 13, 22, 23)

for (i in positive_true) {
  aprobata_scores[[paste0("aprobata_score_", i)]] <- ifelse(is.na(survey[[paste0("aprobata_", i)]]), NA_real_,
    ifelse(survey[[paste0("aprobata_", i)]] == 1, 1, 0)
  )
}
for (i in negative_false) {
  aprobata_scores[[paste0("aprobata_score_", i)]] <- ifelse(is.na(survey[[paste0("aprobata_", i)]]), NA_real_,
    ifelse(survey[[paste0("aprobata_", i)]] == 2, 1, 0)
  )
}

survey <- cbind(survey, aprobata_scores)
survey$APROBATA_SPOLECZNA <- row_sum(survey, names(aprobata_scores))

# Neurotycznosc: itemy spokojne/odwrotne to 1,4,7,10.
for (i in c(1, 4, 7, 10)) {
  survey[[paste0("neuro_", i, "r")]] <- rev_score(survey[[paste0("neuro_", i)]], 5)
}
survey$NEUROTYCZNOSC <- row_mean(
  survey,
  c(
    "neuro_1r", "neuro_2", "neuro_3", "neuro_4r", "neuro_5", "neuro_6",
    "neuro_7r", "neuro_8", "neuro_9", "neuro_10r", "neuro_11", "neuro_12"
  )
)

survey$PROSPOLECZNOSC <- row_mean(survey, paste0("prospol_", 1:8))

# Wyniki eksperymentu karcianego.
experiment_raw <- read.csv2(
  experiment_file,
  stringsAsFactors = FALSE,
  check.names = FALSE,
  fileEncoding = "UTF-8-BOM",
  fill = TRUE
)

names(experiment_raw) <- trimws(names(experiment_raw))
names(experiment_raw)[1] <- "stacja"
experiment_raw <- experiment_raw[grepl("^stacaja_|^stacja_", experiment_raw$stacja), , drop = FALSE]

participant_cols <- setdiff(names(experiment_raw), "stacja")
participant_cols <- participant_cols[nzchar(trimws(participant_cols))]

clean_choice <- function(x) {
  x <- tolower(trimws(as.character(x)))
  x <- gsub("\\s+", "", x)
  x[!(x %in% c("a", "b", "ab", "ba"))] <- NA
  x
}

experiment_long <- do.call(rbind, lapply(participant_cols, function(code) {
  choices <- clean_choice(experiment_raw[[code]])
  data.frame(
    kod_uczestnika_clean = clean_code(code),
    stacja = seq_along(choices),
    wybor_surowy = choices,
    stringsAsFactors = FALSE
  )
}))

experiment_long$stacja_id <- sprintf("stacja_%02d", experiment_long$stacja)
experiment_long$wybor_final <- ifelse(
  experiment_long$wybor_surowy %in% c("a", "ba"), "a",
  ifelse(experiment_long$wybor_surowy %in% c("b", "ab"), "b", NA)
)
experiment_long$zmiana_przekonania <- ifelse(
  is.na(experiment_long$wybor_surowy), NA_real_,
  ifelse(experiment_long$wybor_surowy %in% c("ab", "ba"), 1, 0)
)
experiment_long$silne_przekonanie <- ifelse(
  is.na(experiment_long$wybor_surowy), NA_real_,
  ifelse(experiment_long$wybor_surowy %in% c("a", "b"), 1, 0)
)

experiment_summary <- do.call(rbind, lapply(split(experiment_long, experiment_long$kod_uczestnika_clean), function(d) {
  n_valid <- sum(!is.na(d$wybor_final))
  data.frame(
    kod_uczestnika_clean = d$kod_uczestnika_clean[1],
    exp_n_stacji = n_valid,
    zmiana_przekonania_n = sum(d$zmiana_przekonania == 1, na.rm = TRUE),
    zmiana_przekonania_prop = ifelse(n_valid > 0, mean(d$zmiana_przekonania, na.rm = TRUE), NA_real_),
    SILA_PRZEKONAN = ifelse(n_valid > 0, mean(d$silne_przekonanie, na.rm = TRUE), NA_real_),
    stringsAsFactors = FALSE
  )
}))

experiment_wide <- reshape(
  experiment_long[, c("kod_uczestnika_clean", "stacja_id", "wybor_surowy", "wybor_final", "zmiana_przekonania")],
  idvar = "kod_uczestnika_clean",
  timevar = "stacja_id",
  direction = "wide"
)

names(experiment_wide) <- gsub("\\.", "_", names(experiment_wide))

experiment_prepared <- merge(
  experiment_summary,
  experiment_wide,
  by = "kod_uczestnika_clean",
  all.x = TRUE,
  sort = FALSE
)

merged <- merge(
  survey,
  experiment_prepared,
  by = "kod_uczestnika_clean",
  all.x = TRUE,
  sort = FALSE
)

matched <- merged[!is.na(merged$exp_n_stacji), , drop = FALSE]

# liczenie fundamentów z gry

library(tidyverse)

# klucz stacji z pliku markdown
klucz_stacji <- readr::read_tsv("stacje.md", show_col_types = FALSE) |>
  setNames(c("stacja", "fundament_a", "fundament_b")) |>
  mutate(
    negatywna = str_detect(stacja, "-"),
    stacja = as.integer(str_remove(stacja, "-"))
  )


score_ipsatywne_fundamenty <- function(dane,
                                       klucz = klucz_stacji,
                                       id_col = "kod_uczestnika_clean",
                                       negative_weight = 1) {
  fundamenty <- c("Troska", "Sprawiedliwość", "Lojalność", "Autorytet")
  
  long <- dane |>
    dplyr::select(dplyr::all_of(id_col), dplyr::matches("^wybor_final_stacja_\\d+$")) |>
    tidyr::pivot_longer(
      cols = dplyr::matches("^wybor_final_stacja_\\d+$"),
      names_to = "stacja_col",
      values_to = "wybor"
    ) |>
    dplyr::mutate(
      id = .data[[id_col]],
      stacja = as.integer(stringr::str_extract(stacja_col, "\\d+")),
      wybor = stringr::str_to_lower(as.character(wybor))
    ) |>
    dplyr::left_join(klucz, by = "stacja") |>
    dplyr::filter(wybor %in% c("a", "b")) |>
    dplyr::mutate(
      winner = dplyr::case_when(
        wybor == "a" & !negatywna ~ fundament_a,
        wybor == "b" & !negatywna ~ fundament_b,
        wybor == "a" &  negatywna ~ fundament_b,
        wybor == "b" &  negatywna ~ fundament_a
      ),
      punkty = dplyr::if_else(negatywna, negative_weight, 1)
    )
  
  wyniki_raw <- long |>
    dplyr::group_by(id, winner) |>
    dplyr::summarise(punkty = sum(punkty), .groups = "drop") |>
    tidyr::pivot_wider(
      names_from = winner,
      values_from = punkty,
      values_fill = 0
    ) |> dplyr::arrange(id)
  
  wyniki_raw
}



profil_fundamentow <- score_ipsatywne_fundamenty(matched, negative_weight = 0.5) |>
  left_join(matched, by = c("id" = "kod_uczestnika_clean"))



# zapis
write.csv2(merged, path("outputs", "dane_polaczone_skale.csv"), row.names = FALSE, na = "")
write.csv2(profil_fundamentow, path("outputs", "dane_polaczone_skale_tylko_eksperyment.csv"), row.names = FALSE, na = "")
write.csv2(experiment_long, path("outputs", "wyniki_eksperymentu_long.csv"), row.names = FALSE, na = "")
write.csv2(experiment_prepared, path("outputs", "wyniki_eksperymentu_podsumowanie.csv"), row.names = FALSE, na = "")

duplicate_codes <- unique(survey$kod_uczestnika_clean[duplicated(survey$kod_uczestnika_clean)])
duplicate_codes <- duplicate_codes[!is.na(duplicate_codes) & nzchar(duplicate_codes)]

report <- c(
  paste0("Plik ankietowy: ", basename(survey_file)),
  paste0("Plik JSON: ", basename(json_file)),
  paste0("Plik eksperymentu: ", basename(experiment_file)),
  paste0("Liczba wierszy w ankiecie: ", nrow(survey)),
  paste0("Liczba kodow w eksperymencie: ", length(unique(experiment_summary$kod_uczestnika_clean))),
  paste0("Liczba wierszy po polaczeniu: ", nrow(merged)),
  paste0("Liczba wierszy z wynikami eksperymentu: ", nrow(matched)),
  paste0("Zdublowane kody w ankiecie: ", ifelse(length(duplicate_codes) == 0, "brak", paste(duplicate_codes, collapse = ", "))),
  ""
)

writeLines(report, path("outputs", "raport_przygotowania.txt"), useBytes = TRUE)

cat(paste(report, collapse = "\n"))
cat("\n")