# LehrPuls Forschungs-Kit: Beispielanalyse in R (nur Basis-R, keine Pakete nötig)
#
# Liest den Rohdaten-Export (Langformat, eine Zeile je Antwort) und rechnet
#   1. Schwierigkeit P je Frage (alles-oder-nichts, nur Runde 1)
#   2. Trennschärfe je Frage — wie LehrPuls (obere/untere 27 % je Session,
#      Mittel über Sessions) und zusätzlich punktbiserial
#   3. Peer-Instruction-Gewinn Runde 1 → Runde 2 (wie LehrPuls und gepaart je Person)
#   4. Längsschnitt derselben Frage über Semester
#   5. Antwortzeit-Verteilungen
# und schreibt kennzahlen-fragen.csv, laengsschnitt.csv und analyse-R.png.
#
# Aufruf:
#   Rscript analyse.R                                  # Beispieldatensatz
#   Rscript analyse.R pfad/zum/export.csv              # eigener Datei-Export (CSV)
#   LEHRPULS_SCHLUESSEL=lp_… Rscript analyse.R schnittstelle [kurs=Physik 1&tage=120]
#       # direkt aus der Lese-Schnittstelle (Handbuch 10.9); Schlüssel nie ins Skript
#
# Datei-Export (deutsche Oberfläche): Strichpunkt, Dezimalkomma, UTF-8 mit BOM.
# Schnittstelle (?format=csv): Komma, Dezimalpunkt. Beide Wege landen in derselben Tabelle.

argumente <- commandArgs(trailingOnly = TRUE)
hier <- {
  datei <- sub("^--file=", "", grep("^--file=", commandArgs(), value = TRUE))
  if (length(datei)) dirname(normalizePath(datei)) else getwd()
}
ausgabe <- file.path(hier, "ausgabe")
dir.create(ausgabe, showWarnings = FALSE)

# ---- Laden --------------------------------------------------------------------
lade_datei <- function(pfad) {
  # Export der deutschen Oberfläche: ; und Dezimalkomma. Englische Oberfläche:
  # ; und Dezimalpunkt — read.csv2 erkennt beides, wenn dec passend gesetzt ist.
  kopf <- readLines(pfad, n = 2, encoding = "UTF-8")
  dec <- if (grepl(";[0-9]+,[0-9]+;", kopf[2])) "," else "."
  read.csv(pfad, sep = ";", dec = dec, fileEncoding = "UTF-8-BOM",
           stringsAsFactors = FALSE, na.strings = c("", "NA"))
}
lade_schnittstelle <- function(eingrenzung = "") {
  basis <- Sys.getenv("LEHRPULS_ADRESSE", "http://127.0.0.1:8716/api/v1")
  schluessel <- Sys.getenv("LEHRPULS_SCHLUESSEL")
  if (schluessel == "") stop("Umgebungsvariable LEHRPULS_SCHLUESSEL fehlt")
  adresse <- paste0(basis, "/antworten?format=csv",
                    if (nzchar(eingrenzung)) paste0("&", URLencode(eingrenzung)) else "")
  verbindung <- url(adresse, headers = c(Authorization = paste("Bearer", schluessel)))
  on.exit(close(verbindung))
  read.csv(verbindung, sep = ",", dec = ".", encoding = "UTF-8",
           stringsAsFactors = FALSE, na.strings = c("", "NA"))
}

if (length(argumente) && argumente[1] == "schnittstelle") {
  antworten <- lade_schnittstelle(if (length(argumente) > 1) argumente[2] else "")
} else {
  pfad <- if (length(argumente)) argumente[1] else file.path(hier, "..", "beispieldaten", "antworten.csv")
  antworten <- lade_datei(pfad)
}
cat(sprintf("Geladen: %d Antworten, %d Spalten, %d Sessions, %d Fragen\n",
            nrow(antworten), ncol(antworten),
            length(unique(antworten$session_id)), length(unique(antworten$frage_id))))

# ---- Analysebasis: wie die Auswertungen von LehrPuls -------------------------
# Ausgeschlossenes und Gruppenantworten raus; bewertbar = korrekt gesetzt.
basis <- subset(antworten, ausgeschlossen == 0 & gruppe == 0)
bewertbar <- subset(basis, !is.na(korrekt))
runde1 <- subset(bewertbar, runde == 1)

# ---- 1. Schwierigkeit P (nur Runde 1) -----------------------------------------
p_je_frage <- aggregate(korrekt ~ frage_id + frage_titel + fragetyp, data = runde1,
                        FUN = function(k) c(n = length(k), p = mean(k)))
p_je_frage <- data.frame(frage_id = p_je_frage$frage_id, frage_titel = p_je_frage$frage_titel,
                         fragetyp = p_je_frage$fragetyp,
                         n_runde1 = p_je_frage$korrekt[, "n"], schwierigkeit_p = round(p_je_frage$korrekt[, "p"], 3))

# ---- 2. Trennschärfe -----------------------------------------------------------
# a) wie LehrPuls (stats.rs): je Session Gesamtscore je Person über Runde 1,
#    obere und untere Gruppe = round(0,27 · n), mindestens 1, höchstens n/2;
#    Trennschärfe der Frage = Anteil richtig oben − Anteil richtig unten;
#    über Sessions gemittelt.
trennschaerfe_lehrpuls <- function(d) {
  werte <- list()
  for (sid in unique(d$session_id)) {
    s <- d[d$session_id == sid, ]
    score <- tapply(s$korrekt, s$teilnehmer_id, sum)
    if (length(score) < 2) next
    rang <- sort(score, decreasing = TRUE)
    g <- max(1, min(round(0.27 * length(rang)), length(rang) %/% 2))
    oben <- names(rang)[seq_len(g)]
    unten <- names(rev(rang))[seq_len(g)]
    for (fid in unique(s$frage_id)) {
      f <- s[s$frage_id == fid, ]
      o <- f$korrekt[f$teilnehmer_id %in% oben]
      u <- f$korrekt[f$teilnehmer_id %in% unten]
      if (length(o) && length(u)) werte[[length(werte) + 1]] <- data.frame(frage_id = fid, d = mean(o) - mean(u))
    }
  }
  w <- do.call(rbind, werte)
  aggregate(d ~ frage_id, data = w, FUN = mean)
}
ts <- trennschaerfe_lehrpuls(runde1)
names(ts)[2] <- "trennschaerfe"
ts$trennschaerfe <- round(ts$trennschaerfe, 3)

# b) punktbiserial (Forschungsvariante): Korrelation der Antwort mit dem
#    Gesamtscore derselben Person in der Session ohne diese Frage.
runde1$score_session <- ave(runde1$korrekt, runde1$session_id, runde1$teilnehmer_id, FUN = sum)
runde1$rest <- runde1$score_session - runde1$korrekt
rpb <- aggregate(cbind(korrekt, rest) ~ frage_id, data = runde1,
                 FUN = function(x) x, simplify = FALSE)
rpb <- do.call(rbind, lapply(split(runde1, runde1$frage_id), function(f) {
  r <- if (sd(f$korrekt) > 0 && sd(f$rest) > 0) cor(f$korrekt, f$rest) else NA
  data.frame(frage_id = f$frage_id[1], r_punktbiserial = round(r, 3))
}))

# ---- 3. Peer-Instruction-Gewinn -----------------------------------------------
# a) wie LehrPuls (pi_p_runde1 / pi_p_runde2): P je Runde über alle Antworten
#    der Frage im Zeitraum, nur Fragen mit Antworten in beiden Runden.
pi_app <- do.call(rbind, lapply(split(bewertbar, bewertbar$frage_id), function(f) {
  r1 <- f$korrekt[f$runde == 1]; r2 <- f$korrekt[f$runde == 2]
  if (!length(r2)) return(NULL)
  data.frame(frage_id = f$frage_id[1], frage_titel = f$frage_titel[1],
             n1 = length(r1), n2 = length(r2), pi_p_runde1 = round(mean(r1), 3), pi_p_runde2 = round(mean(r2), 3))
}))
# b) gepaart je Person (Forschungsvariante): nur Sessions mit zweiter Runde,
#    Wechsel falsch→richtig und richtig→falsch zählen (Grundlage für McNemar).
paare <- merge(
  subset(bewertbar, runde == 1, c(session_id, frage_id, teilnehmer_id, korrekt)),
  subset(bewertbar, runde == 2, c(session_id, frage_id, teilnehmer_id, korrekt)),
  by = c("session_id", "frage_id", "teilnehmer_id"), suffixes = c("_r1", "_r2"))
pi_paare <- do.call(rbind, lapply(split(paare, paare$frage_id), function(f) data.frame(
  frage_id = f$frage_id[1], paare = nrow(f),
  falsch_zu_richtig = sum(f$korrekt_r1 == 0 & f$korrekt_r2 == 1),
  richtig_zu_falsch = sum(f$korrekt_r1 == 1 & f$korrekt_r2 == 0),
  gewinn_gepaart = round(mean(f$korrekt_r2) - mean(f$korrekt_r1), 3),
  mcnemar_p = {
    b <- sum(f$korrekt_r1 == 0 & f$korrekt_r2 == 1); c <- sum(f$korrekt_r1 == 1 & f$korrekt_r2 == 0)
    if (b + c > 0) round(mcnemar.test(matrix(c(0, b, c, 0), 2))$p.value, 4) else NA
  })))
pi <- merge(pi_app, pi_paare, by = "frage_id")
cat(sprintf("\nPeer Instruction: %d Fragen mit zweiter Runde, mittlerer gepaarter Gewinn %.3f\n",
            nrow(pi), mean(pi$gewinn_gepaart)))

# ---- 4. Längsschnitt derselben Frage über Semester ----------------------------
laengs <- aggregate(korrekt ~ frage_id + frage_titel + semester, data = runde1,
                    FUN = function(k) c(n = length(k), p = mean(k)))
laengs <- data.frame(frage_id = laengs$frage_id, frage_titel = laengs$frage_titel, semester = laengs$semester,
                     n = laengs$korrekt[, "n"], p = round(laengs$korrekt[, "p"], 3))
# Semester chronologisch sortieren: "WS 2025/26" < "SS 2026" < "WS 2026/27"
semester_schluessel <- function(s) {
  jahr <- as.numeric(sub(".*?(20[0-9]{2}).*", "\\1", s))
  jahr + ifelse(grepl("^WS", s), 0.75, 0.25)
}
laengs <- laengs[order(laengs$frage_id, semester_schluessel(laengs$semester)), ]
breit <- reshape(laengs[, c("frage_id", "semester", "p")], idvar = "frage_id", timevar = "semester", direction = "wide")
names(breit) <- sub("^p\\.", "P ", names(breit))
spannweite <- apply(breit[, -1], 1, function(x) diff(range(x, na.rm = TRUE)))
breit$spannweite <- round(spannweite, 3)
write.csv(breit[order(-breit$spannweite), ], file.path(ausgabe, "laengsschnitt.csv"), row.names = FALSE)

# ---- 5. Antwortzeiten ----------------------------------------------------------
zeit <- subset(basis, !is.na(dauer_s))
cat("\nMedian der Bearbeitungszeit (s) je Fragetyp:\n")
print(round(tapply(zeit$dauer_s, zeit$fragetyp, median), 1))
zr <- subset(zeit, fragetyp == "mc_single" & !is.na(korrekt))
cat("\nMedian (s) Single Choice nach Runde und Richtigkeit:\n")
print(round(tapply(zr$dauer_s, list(runde = zr$runde, korrekt = zr$korrekt), median), 1))

# ---- Kennzahlen-Tabelle zusammenführen und schreiben -------------------------
kenn <- Reduce(function(a, b) merge(a, b, by = "frage_id", all.x = TRUE),
               list(p_je_frage, ts, rpb, pi[, c("frage_id", "pi_p_runde1", "pi_p_runde2", "gewinn_gepaart", "mcnemar_p")]))
kenn$hinweis <- with(kenn, ifelse(n_runde1 < 10, "unter Mindestbasis n=10",
                       ifelse(!is.na(trennschaerfe) & trennschaerfe <= 0, "Trennschärfe <= 0: Lösung prüfen",
                       ifelse(schwierigkeit_p > 0.9, "zu leicht", ifelse(schwierigkeit_p < 0.3, "zu schwer", "")))))
kenn <- kenn[order(kenn$trennschaerfe), ]
write.csv(kenn, file.path(ausgabe, "kennzahlen-fragen.csv"), row.names = FALSE)
cat("\nFragen mit Hinweis:\n")
print(kenn[kenn$hinweis != "", c("frage_id", "frage_titel", "n_runde1", "schwierigkeit_p", "trennschaerfe", "hinweis")], row.names = FALSE)

# ---- Grafik -------------------------------------------------------------------
petrol <- "#0e8a80"; grau <- "#56666b"; rot <- "#b5484a"
png(file.path(ausgabe, "analyse-R.png"), width = 1800, height = 1400, res = 160)
par(mfrow = c(2, 2), mar = c(4.5, 4.5, 3, 1), family = "sans")
# a) Gütekarte
plot(kenn$schwierigkeit_p, kenn$trennschaerfe, pch = 19, col = ifelse(kenn$trennschaerfe <= 0, rot, petrol),
     xlim = c(0, 1), ylim = c(-0.5, 1), xlab = "Schwierigkeit P (Runde 1)", ylab = "Trennschärfe (obere − untere 27 %)",
     main = "Gütekarte je Frage")
abline(v = c(0.3, 0.9), h = 0, lty = 3, col = grau)
text(kenn$schwierigkeit_p[kenn$hinweis != ""], kenn$trennschaerfe[kenn$hinweis != ""],
     kenn$frage_id[kenn$hinweis != ""], pos = 3, cex = 0.7, col = grau)
# b) Peer Instruction: Hantel je Frage
o <- order(pi$pi_p_runde1)
plot(NA, xlim = c(0, 1), ylim = c(0.5, nrow(pi) + 0.5), yaxt = "n", xlab = "Anteil richtig", ylab = "",
     main = "Peer Instruction: Runde 1 und Runde 2")
segments(pi$pi_p_runde1[o], seq_along(o), pi$pi_p_runde2[o], seq_along(o), col = grau)
points(pi$pi_p_runde1[o], seq_along(o), pch = 19, col = grau)
points(pi$pi_p_runde2[o], seq_along(o), pch = 19, col = petrol)
axis(2, at = seq_along(o), labels = pi$frage_titel[o], las = 1, cex.axis = 0.65)
legend("bottomright", c("Runde 1", "Runde 2"), pch = 19, col = c(grau, petrol), bty = "n", cex = 0.8)
# c) Längsschnitt: die vier Fragen mit der größten Spannweite
top <- head(breit$frage_id[order(-breit$spannweite)], 4)
sem <- unique(laengs$semester[order(semester_schluessel(laengs$semester))])
plot(NA, xlim = c(1, length(sem)), ylim = c(0, 1), xaxt = "n", xlab = "Semester", ylab = "Schwierigkeit P",
     main = "Längsschnitt derselben Frage")
axis(1, at = seq_along(sem), labels = sem)
farben <- c(petrol, rot, grau, "#d9a441")
for (i in seq_along(top)) {
  l <- laengs[laengs$frage_id == top[i], ]
  lines(match(l$semester, sem), l$p, type = "b", pch = 19, col = farben[i], lwd = 2)
}
legend("bottomleft", paste(top, kenn$frage_titel[match(top, kenn$frage_id)]), col = farben, lwd = 2, bty = "n", cex = 0.7)
# d) Antwortzeiten Single Choice, Runde 1 gegen Runde 2 (log-Skala)
d1 <- log10(zr$dauer_s[zr$runde == 1]); d2 <- log10(zr$dauer_s[zr$runde == 2])
hist(d1, breaks = 40, col = adjustcolor(grau, 0.5), border = NA, xlab = "Bearbeitungszeit (s, log-Skala)",
     main = "Antwortzeiten Single Choice", xaxt = "n", freq = FALSE)
hist(d2, breaks = 40, col = adjustcolor(petrol, 0.6), border = NA, add = TRUE, freq = FALSE)
axis(1, at = log10(c(3, 10, 30, 100, 300)), labels = c(3, 10, 30, 100, 300))
legend("topright", c("Runde 1", "Runde 2"), fill = c(adjustcolor(grau, 0.5), adjustcolor(petrol, 0.6)), bty = "n", cex = 0.8)
dev.off()
cat(sprintf("\nGeschrieben: %s\n", paste(file.path(ausgabe, c("kennzahlen-fragen.csv", "laengsschnitt.csv", "analyse-R.png")), collapse = ", ")))