# Präambel ####

PFAD_DOWNLOAD_SKRIPT  = "../API/get_data_stai.R"
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
PFAD_NORMTABELLEN     = "normtabellen"
AKZENT_FARBE          = "#8B2635"

STAI_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
  "Fuer die State-Skala existieren laut Testmanual keine Normtabellen; fuer die ",
  "Trait-Skala ist kein fester klinischer Cutoff definiert."
)

# Verlauf gruen -> dunkelrot entspricht den 4 Antwortstufen 1-4 NACH Umpolung
# (Stufe = Ausmass der angezeigten Angst durch diese Antwort, nicht der Rohwert -
# bei Umkehr-Items zeigt sonst z.B. "sehr ruhig" faelschlich als dunkelrot an).
STAI_BADGE_FARBEN = c(
  "1" = "#4CAF50",
  "2" = "#F48FB1",
  "3" = "#EF5350",
  "4" = "#B71C1C"
)
STAI_BADGE_TEXT_FARBEN = c(
  "1" = "white",
  "2" = "#333333",
  "3" = "white",
  "4" = "white"
)

library(shiny)
library(dplyr)
library(ggplot2)
library(haven)
library(officer)
library(DBI)
library(RSQLite)


# Infrastruktur ####

APP_VERZEICHNIS = normalizePath(getwd())

absPath = function(pfad) {
  if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
  file.path(APP_VERZEICHNIS, pfad)
}

PFAD_DOWNLOAD_SKRIPT  = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT),  mustWork = FALSE)
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)
PFAD_NORMTABELLEN     = normalizePath(absPath(PFAD_NORMTABELLEN),     mustWork = TRUE)


# Helper ####

# Entfernt Markdown-Reste aus formr-Itemtexten: fuehrende, escapete Itemnummer
# ("1\\. ...") und Fettschrift-Sternchen. Wird an jeder Stelle verwendet, an der
# Itemtext oder Introtext angezeigt wird (UI und Word-Export gleichermassen).
bereinige_markdown = function(text) {
  x = as.character(text)
  x = ifelse(is.na(x), "", x)
  x = gsub("^\\d+\\\\\\.\\s*", "", x)
  x = gsub("\\*\\*", "", x)
  x = trimws(x)
  x
}

# Feste Ankertexte laut STAI-G-Testheft, nur als Fallback wenn das labels-Attribut
# der Originalspalte fehlt oder leer ist, der Spaltenwert aber bereits eine Zahl
# 1-4 ist.
stai_anker_fest = list(
  state = c("ueberhaupt nicht", "ein wenig", "ziemlich", "sehr"),
  trait = c("fast nie", "manchmal", "oft", "fast immer")
)

# Extrahiert Rohwert (1-4) und Antworttext eines einzelnen STAI-Items.
# Das Exportverhalten von formr-Items vom Typ "mc" (im Unterschied zu "mc_button")
# ist in dieser Kombination nicht am realen Export verifiziert - deshalb wird hier
# NIE der numerische Rohcode direkt uebernommen. Stattdessen bestimmt die
# aufsteigend sortierte Rangfolge der Werte im labels-Attribut den Rohwert 1-4;
# der Antworttext ist der zugehoerige Attribut-Name. Ist das Attribut leer, aber
# der Spaltenwert bereits eine Zahl 1-4, wird diese Zahl direkt uebernommen (Text
# dann aus dem festen Mapping). Ist der Wert weder so noch so zuordenbar: NA.
stai_item_extrahieren = function(spalten_wert, spalten_labels, skala) {
  if (length(spalten_wert) == 0 || is.na(spalten_wert[1])) {
    return(list(wert = NA_real_, antwort = NA_character_))
  }
  wert_roh = spalten_wert[1]

  if (!is.null(spalten_labels) && length(spalten_labels) > 0) {
    reihenfolge  = order(as.vector(spalten_labels))
    lbl_sortiert = spalten_labels[reihenfolge]
    pos = which(as.vector(lbl_sortiert) == suppressWarnings(as.numeric(wert_roh)))
    if (length(pos) > 0 && pos[1] >= 1 && pos[1] <= 4) {
      return(list(wert = as.numeric(pos[1]), antwort = names(lbl_sortiert)[pos[1]]))
    }
  }

  wert_num = suppressWarnings(as.numeric(wert_roh))
  if (!is.na(wert_num) && wert_num %in% 1:4) {
    return(list(wert = wert_num, antwort = stai_anker_fest[[skala]][wert_num]))
  }

  list(wert = NA_real_, antwort = NA_character_)
}

# Loest den Antworttext einer labelled Spalte ueber deren labels-Attribut auf,
# NIE ueber den Rohwert direkt (z.B. bei geschlecht, dessen 1/2-Kodierung nicht
# feststeht).
stai_label_text = function(spalten_wert, spalten_labels) {
  if (length(spalten_wert) == 0 || is.na(spalten_wert[1])) return(NA_character_)
  if (is.null(spalten_labels) || length(spalten_labels) == 0) return(NA_character_)
  pos = which(as.vector(spalten_labels) == suppressWarnings(as.numeric(spalten_wert[1])))
  if (length(pos) == 0) return(NA_character_)
  trimws(names(spalten_labels)[pos[1]])
}

# Polt Item-Rohwerte um (Wert = 5 - Rohwert) fuer alle Items, deren Spaltenname
# in umkehr_namen vorkommt; alle uebrigen Items bleiben unveraendert.
stai_umpolen = function(werte, umkehr_namen) {
  ergebnis = ifelse(names(werte) %in% umkehr_namen, 5 - werte, werte)
  names(ergebnis) = names(werte)
  ergebnis
}

# Wendet die Missing-Value-Regel je Skala an: >2 fehlende Items -> nicht
# auswertbar; 1-2 fehlende Items -> Schaetzwert aus vorhandenen Items,
# aufgerundet; 0 fehlende Items -> normale Summe.
stai_score = function(werte) {
  n_missing = sum(is.na(werte))
  if (n_missing > 2) {
    return(list(rohwert = NA_real_, missing_n = n_missing, auswertbar = FALSE))
  }
  if (n_missing == 0) {
    rohwert = sum(werte)
  } else {
    rohwert = ceiling(mean(werte, na.rm = TRUE) * length(werte))
  }
  list(rohwert = rohwert, missing_n = n_missing, auswertbar = TRUE)
}

# Bestimmt das Normtabellen-Suffix aus dem Alter. NA (inkl. Alter < 15) bedeutet
# Fallback auf die Gesamttabelle, wird vom Aufrufer sichtbar gemacht.
stai_altersgruppe = function(alter) {
  if (is.na(alter) || alter < 15) return(NA_character_)
  if (alter <= 29) return("_15_29")
  if (alter <= 59) return("_30_59")
  return("_60plus")
}

# Exakter Rohwert-Lookup in einer Normtabelle. Kein Treffer (Rohwert ausserhalb
# der Stichprobe) -> alle Werte NA, vom Aufrufer als "kein Normwert ausgewiesen"
# anzuzeigen statt eines erratenen/interpolierten Werts.
stai_normlookup = function(tabelle, rohwert) {
  zeile = tabelle[tabelle$rohwert == rohwert, , drop = FALSE]
  if (nrow(zeile) == 0) {
    return(list(t_wert = NA_real_, stanine = NA_real_, prozentrang = NA_real_, gefunden = FALSE))
  }
  list(
    t_wert      = suppressWarnings(as.numeric(zeile$t_wert[1])),
    stanine     = suppressWarnings(as.numeric(zeile$stanine[1])),
    prozentrang = suppressWarnings(as.numeric(zeile$prozentrang[1])),
    gefunden    = TRUE
  )
}

# Neutraler, farbzonenfreier Prozentrang-Balken (kein Cutoff, da im Manual
# keiner definiert ist).
stai_prozentrang_plot = function(prozentrang) {
  df_marker = data.frame(x = prozentrang, y = 1)

  ggplot() +
    geom_segment(aes(x = 0, xend = 100, y = 1, yend = 1),
                 color = "#D9D9D9", linewidth = 10, lineend = "round") +
    geom_point(data = df_marker, aes(x = x, y = y), shape = 24, size = 4.5,
               color = "#444444", fill = "#444444") +
    scale_x_continuous(limits = c(0, 100), breaks = c(0, 25, 50, 75, 100)) +
    scale_y_continuous(limits = c(0.5, 1.5)) +
    labs(x = "Prozentrang", y = NULL) +
    theme_minimal(base_size = 12) +
    theme(
      axis.text.y  = element_blank(),
      axis.ticks.y = element_blank(),
      panel.grid.major.y = element_blank(),
      panel.grid.minor   = element_blank()
    )
}


# Datenaufbereitung ####

stai_state_umkehr_items = c(
  stai_state_01 = TRUE, stai_state_02 = TRUE, stai_state_05 = TRUE, stai_state_08 = TRUE,
  stai_state_10 = TRUE, stai_state_11 = TRUE, stai_state_15 = TRUE, stai_state_16 = TRUE,
  stai_state_19 = TRUE, stai_state_20 = TRUE
)

stai_trait_umkehr_items = c(
  stai_trait_01 = TRUE, stai_trait_06 = TRUE, stai_trait_07 = TRUE, stai_trait_10 = TRUE,
  stai_trait_13 = TRUE, stai_trait_16 = TRUE, stai_trait_19 = TRUE
)

stai_normtabellen_dateien = c(
  frauen_gesamt  = "frauen_gesamt.csv",  frauen_15_29  = "frauen_15_29.csv",
  frauen_30_59   = "frauen_30_59.csv",   frauen_60plus = "frauen_60plus.csv",
  maenner_gesamt = "maenner_gesamt.csv", maenner_15_29 = "maenner_15_29.csv",
  maenner_30_59  = "maenner_30_59.csv",  maenner_60plus = "maenner_60plus.csv"
)

stai_normtabellen = list()
for (schluessel in names(stai_normtabellen_dateien)) {
  datei = stai_normtabellen_dateien[[schluessel]]
  pfad  = file.path(PFAD_NORMTABELLEN, datei)

  if (!file.exists(pfad)) {
    stop(paste0("Normtabelle nicht gefunden: ", pfad))
  }

  tab = tryCatch(
    read.csv(pfad, stringsAsFactors = FALSE),
    error = function(e) stop(paste0("Fehler beim Einlesen von '", datei, "': ", e$message))
  )

  for (spalte in c("rohwert", "t_wert", "stanine", "prozentrang")) {
    if (!(spalte %in% names(tab))) {
      stop(paste0("Normtabelle '", datei, "' hat keine Spalte '", spalte, "'."))
    }
  }

  stai_normtabellen[[schluessel]] = tab
}

# Bekannter Vorbehalt zur Datenqualitaet (noch nicht gegen die Originalquelle
# verifiziert): frauen_60plus, rohwert = 60 -> T-Wert-Monotonie-Anomalie (67 -> 66);
# maenner_60plus, rohwert = 60 -> Prozentrang-Monotonie-Anomalie (99 -> 98).
stai_bekannte_anomalien = list(
  list(tabelle = "frauen_60plus",  rohwert = 60),
  list(tabelle = "maenner_60plus", rohwert = 60)
)

stai_ist_bekannte_anomalie = function(tabelle, rohwert) {
  any(sapply(stai_bekannte_anomalien, function(a) {
    identical(a$tabelle, tabelle) && !is.na(rohwert) && identical(a$rohwert, rohwert)
  }))
}


# UI ####

app_css = "
body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; }
.container-fluid { max-width: 1100px; }
.app-header {
  background: #8B2635; color: white; padding: 18px 24px 14px;
  margin-bottom: 20px; border-radius: 0 0 6px 6px;
}
.app-header h2 { margin: 0; font-size: 1.5rem; font-weight: 600; }
.app-header p  { margin: 4px 0 0; opacity: 0.85; font-size: 0.9rem; }
.input-panel {
  background: white; border-radius: 6px; padding: 16px 20px;
  margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
  display: flex; align-items: flex-end; gap: 12px; flex-wrap: wrap;
}
.input-panel .form-group { margin-bottom: 0; }
.input-panel label { font-weight: 600; color: #333; }
.btn-laden {
  background: #8B2635 !important; color: white !important;
  border: none !important; border-radius: 4px !important;
  padding: 8px 20px !important; font-weight: 600 !important; cursor: pointer;
}
.btn-laden:hover { background: #6d1e29 !important; }
.alert-fehler {
  background: #FFEBEE; border-left: 5px solid #C62828;
  padding: 12px 16px; border-radius: 4px; color: #B71C1C;
  margin-bottom: 12px; font-weight: 500;
}
.alert-warnung {
  background: #FFF3E0; border-left: 5px solid #E65100;
  padding: 10px 16px; border-radius: 4px; color: #BF360C;
  margin-bottom: 12px; font-size: 0.93em; font-weight: 500;
}
.abschnitt-karte {
  background: white; border-radius: 6px; padding: 20px 24px;
  margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
}
.abschnitt-titel {
  color: #8B2635; font-size: 1.15rem; font-weight: 700;
  border-bottom: 2px solid #8B2635; padding-bottom: 8px; margin-bottom: 14px;
}
.skalen-reihe { display: flex; gap: 16px; flex-wrap: wrap; }
.skalen-reihe .abschnitt-karte { flex: 1; min-width: 280px; }
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
.meta-block strong { color: #222; }
.rohwert-anzeige { font-size: 1.6rem; font-weight: 700; color: #222; }
.rohwert-hinweis { color: #777; font-size: 0.88em; margin-top: 4px; }
.normtabelle-info { margin-bottom: 14px; color: #444; font-size: 0.92em; }
.disclaimer-block {
  font-size: 0.82em; color: #777; font-style: italic;
  margin-top: 10px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
}
.item-zeile {
  display: flex; align-items: flex-start; gap: 10px;
  padding: 7px 0; border-bottom: 1px solid #F0F0F0;
}
.item-nr      { font-weight: 600; color: #8B2635; min-width: 22px; flex-shrink: 0; }
.item-text    { flex: 2; color: #333; font-size: 0.92em; }
.item-antwort { flex: 1; display: flex; justify-content: flex-end; min-width: 140px; }
.antwort-badge {
  display: inline-block; border-radius: 3px; padding: 2px 10px;
  font-size: 0.85em; font-weight: 700; min-width: 90px; text-align: center;
  flex-shrink: 0; background-color: #EDEDED; color: #444;
}
.antwort-badge-1 { background-color: #4CAF50; color: white; }
.antwort-badge-2 { background-color: #F48FB1; color: #333333; }
.antwort-badge-3 { background-color: #EF5350; color: white; }
.antwort-badge-4 { background-color: #B71C1C; color: white; }
.antwort-badge-fehlend { background-color: #FEECEB; color: #B71C1C; }
"

app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)

ui = fluidPage(
  tags$head(
    tags$meta(charset = "UTF-8"),
    tags$style(HTML(app_css))
  ),

  div(class = "app-header",
    tags$h2("STAI-G (State- und Trait-Angstskala)"),
    tags$p("Einzelfall-Auswertung, kombinierte Erhebung")
  ),

  div(class = "container-fluid",

    div(class = "input-panel",
      div(style = "min-width: 360px; white-space: nowrap;",
        textInput("pseudonym",
                   label = tagList(
                     "Pseudonym",
                     tags$span(style = "font-weight: normal; font-style: italic; font-size: 0.78em; color: #888; margin-left: 4px; white-space: nowrap;",
                               "optional, hat Vorrang vor Chiffre")
                   ),
                   placeholder = "optional", width = "340px")
      ),
      div(style = "min-width: 200px;",
        textInput("chiffre", label = "Patientenchiffre",
                  placeholder = "z.B. P000123", width = "100%")
      ),
      actionButton("btn_suchen", "Auswerten", class = "btn btn-primary btn-laden"),
      div(style = "margin-left: auto;",
        downloadButton("download_word", "Word-Export (.docx)")
      )
    ),

    uiOutput("fehler_ui"),
    uiOutput("warnung_mehrfach_ui"),
    uiOutput("warnung_normtabelle_ui"),
    uiOutput("normtabelle_auswahl_ui"),
    uiOutput("ergebnis_ui")
  )
)


# Word-Export ####

erstelle_stai_docx = function(erg) {
  doc = read_docx()

  fp_titel      = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
  fp_abschnitt  = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 13)
  fp_label      = fp_text(bold = TRUE, font.size = 11)
  fp_normal     = fp_text(font.size = 11)
  fp_warnung    = fp_text(font.size = 10, italic = TRUE, color = "#BF360C")
  fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")

  doc = body_add_fpar(doc, fpar(ftext("STAI-G", fp_titel)))
  doc = body_add_fpar(doc, fpar(
    ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_normal),
    ftext("     Ausfuelldatum: ", fp_label), ftext(erg$ausfuelldatum, fp_normal),
    ftext("     Alter: ", fp_label),
    ftext(if (is.na(erg$alter)) "nicht auswertbar" else as.character(erg$alter), fp_normal),
    ftext("     Geschlecht: ", fp_label),
    ftext(if (is.na(erg$geschlecht)) "nicht zuordenbar" else erg$geschlecht, fp_normal)
  ))
  if (!is.null(erg$mehrere_treffer_warnung)) {
    doc = body_add_fpar(doc, fpar(ftext(
      paste0("Mehrere Ausfuellungen gefunden (", erg$mehrere_treffer_warnung$n,
             " Eintraege), es wird die neueste angezeigt."), fp_warnung
    )))
  }
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("State-Angst (aktueller Zustand)", fp_abschnitt)))
  state_txt = if (isTRUE(erg$state_auswertbar)) {
    sprintf("Rohwert: %d / 80", as.integer(erg$state_rohwert))
  } else {
    "nicht auswertbar (mehr als 2 fehlende Antworten)"
  }
  doc = body_add_fpar(doc, fpar(ftext(state_txt, fp_normal)))
  doc = body_add_fpar(doc, fpar(ftext(
    "Kein Normvergleich moeglich, Skala zur Veraenderungsmessung konstruiert.", fp_disclaimer
  )))
  doc = body_add_par(doc, "", style = "Normal")

  doc = body_add_fpar(doc, fpar(ftext("Trait-Angst (allgemeine Aengstlichkeit)", fp_abschnitt)))
  if (isTRUE(erg$trait_auswertbar)) {
    doc = body_add_fpar(doc, fpar(ftext(
      sprintf("Rohwert: %d / 80", as.integer(erg$trait_rohwert)), fp_normal
    )))
    norm_txt = if (isTRUE(erg$trait_norm_gefunden)) {
      sprintf("T-Wert: %s     Stanine: %s     Prozentrang: %s     (Normtabelle: %s)",
              format(erg$trait_t_wert), format(erg$trait_stanine),
              format(erg$trait_prozentrang), erg$tabelle_verwendet)
    } else {
      sprintf("kein Normwert ausgewiesen (Bereich der Stichprobe verlassen)     (Normtabelle: %s)",
              erg$tabelle_verwendet)
    }
    doc = body_add_fpar(doc, fpar(ftext(norm_txt, fp_normal)))
    if (!is.null(erg$tabelle_anomalie_hinweis)) {
      doc = body_add_fpar(doc, fpar(ftext(erg$tabelle_anomalie_hinweis, fp_warnung)))
    }
    if (isTRUE(erg$altersgruppen_fallback)) {
      doc = body_add_fpar(doc, fpar(ftext(
        "Alter ausserhalb der normierten Altersgruppen, es wurde die Gesamttabelle verwendet.",
        fp_warnung
      )))
    }
  } else {
    doc = body_add_fpar(doc, fpar(ftext(
      "nicht auswertbar (mehr als 2 fehlende Antworten)", fp_normal
    )))
  }
  doc = body_add_par(doc, "", style = "Normal")

  fuege_item_liste_hinzu = function(doc, titel, items) {
    doc = body_add_fpar(doc, fpar(ftext(titel, fp_abschnitt)))
    for (it in items) {
      antwort_txt = if (is.na(it$wert) || is.na(it$antwort)) "nicht zuordenbar" else it$antwort
      doc = body_add_fpar(doc, fpar(
        ftext(sprintf("%2d. ", it$nr), fp_text(bold = TRUE, font.size = 10)),
        ftext(paste0(it$text, "  -  "), fp_normal),
        ftext(antwort_txt, fp_text(italic = TRUE, font.size = 10, color = "#555555"))
      ))
    }
    doc = body_add_par(doc, "", style = "Normal")
    doc
  }

  doc = fuege_item_liste_hinzu(doc, "Trait-Items", erg$trait_items)
  doc = fuege_item_liste_hinzu(doc, "State-Items", erg$state_items)

  doc = body_add_fpar(doc, fpar(ftext(STAI_DISCLAIMER, fp_disclaimer)))

  doc
}


# Server ####

server = function(input, output, session) {
  # --- pseudonym-support-injection v1 ---
  observe({
    query = parseQueryString(session$clientData$url_search)
    if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
      updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
    }
  })

  observe({
    query = parseQueryString(session$clientData$url_search)
    if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
      updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
    }
  })

  tabelle_override = reactiveVal(NULL)

  erg_aktuell = eventReactive(input$btn_suchen, {

    chiffre = toupper(trimws(input$chiffre))

    if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) || !(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
      return(list(typ = "format_fehler",
        meldung = "Ungueltige Chiffre. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123)."))
    }

    fehlende_skripte = c(
      if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) PFAD_DOWNLOAD_SKRIPT,
      if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) PFAD_PSEUDONYM_SKRIPT
    )
    if (length(fehlende_skripte) > 0) {
      return(list(typ = "pfad_fehler",
        meldung = paste0("Skript(e) nicht gefunden:\n", paste(fehlende_skripte, collapse = "\n"))))
    }

    ok_dl = tryCatch(
      { source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); list(ok = TRUE) },
      error = function(e) list(ok = FALSE, msg = e$message)
    )
    if (!ok_dl$ok) {
      return(list(typ = "skript_fehler",
        meldung = paste0("Fehler im Download-Skript: ", ok_dl$msg)))
    }

    if (!exists("daten_stai_state_trait", envir = .GlobalEnv) ||
        !is.data.frame(get("daten_stai_state_trait", envir = .GlobalEnv))) {
      return(list(typ = "daten_fehler",
        meldung = "Objekt 'daten_stai_state_trait' nach dem Sourcen nicht gefunden oder kein Dataframe."))
    }
    daten_stai_state_trait = get("daten_stai_state_trait", envir = .GlobalEnv)

    db_ordner = local({
      ordner   = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
      gefunden = NULL
      for (i in 1:5) {
        if (file.exists(file.path(ordner, "pseudonyme.db"))) {
          gefunden = ordner
          break
        }
        elternteil = dirname(ordner)
        if (elternteil == ordner) break
        ordner = elternteil
      }
      gefunden
    })
    if (is.null(db_ordner)) {
      return(list(typ = "db_fehler",
        meldung = paste0("pseudonyme.db nicht gefunden (bis 5 Ebenen oberhalb von ",
          dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE)), " gesucht).")))
    }

    alter_wd = getwd()
    setwd(db_ordner)
    on.exit(setwd(alter_wd), add = TRUE)

    ok_ps = tryCatch(
      { source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
      if (nchar(trimws(input$pseudonym)) > 0) {
        .pw_wert = trimws(input$pseudonym)
        .pw_tab = get("pseudo", envir = .GlobalEnv)
        .pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ]
        if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1]))
      }; list(ok = TRUE) },
      error = function(e) list(ok = FALSE, msg = e$message)
    )
    if (!ok_ps$ok) {
      return(list(typ = "db_fehler",
        meldung = paste0("Fehler im Pseudonym-Skript: ", ok_ps$msg)))
    }
    if (!exists("pseudo", envir = .GlobalEnv) || !is.data.frame(get("pseudo", envir = .GlobalEnv))) {
      return(list(typ = "db_fehler",
        meldung = "Objekt 'pseudo' nach dem Sourcen nicht gefunden oder kein Dataframe."))
    }
    pseudo = get("pseudo", envir = .GlobalEnv)

    treffer_ps = pseudo[toupper(trimws(as.character(pseudo$chiffre))) == chiffre, ]
    if (nrow(treffer_ps) == 0) {
      return(list(typ = "chiffre_nicht_gefunden",
        meldung = paste0("Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden.")))
    }

    session_ids = unique(as.character(treffer_ps$pseudonym))
    if (nchar(trimws(input$pseudonym)) > 0) session_ids = trimws(input$pseudonym)
    treffer_dat = daten_stai_state_trait[as.character(daten_stai_state_trait$session) %in% session_ids, , drop = FALSE]
    if (nrow(treffer_dat) == 0) {
      return(list(typ = "session_nicht_gefunden",
        meldung = paste0("Kein STAI-Datensatz fuer Chiffre '", chiffre, "' gefunden. (",
          length(session_ids), " Pseudonym(e) geprueft)")))
    }

    mehrere_treffer_warnung = NULL
    if (nrow(treffer_dat) > 1) {
      n = nrow(treffer_dat)
      idx_neu = which.max(as.POSIXct(treffer_dat$created))
      treffer_dat = treffer_dat[idx_neu, , drop = FALSE]
      mehrere_treffer_warnung = list(n = n)
    }

    zeile = treffer_dat[1, , drop = FALSE]

    ausfuelldatum = tryCatch(
      format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
      error = function(e) "unbekannt"
    )

    alter_roh = suppressWarnings(as.numeric(zeile[["alter"]][1]))
    alter     = if (!is.na(alter_roh) && alter_roh > 0) alter_roh else NA_real_

    geschlecht_txt = stai_label_text(zeile[["geschlecht"]], attr(daten_stai_state_trait[["geschlecht"]], "labels"))
    geschlecht = if (!is.na(geschlecht_txt) && grepl("^weiblich$", geschlecht_txt, ignore.case = TRUE)) {
      "weiblich"
    } else if (!is.na(geschlecht_txt) && grepl("^m(a|ä)nnlich$", geschlecht_txt, ignore.case = TRUE)) {
      "maennlich"
    } else {
      NA_character_
    }

    extrahiere_items = function(praefix, skala) {
      cols = sprintf("%s_%02d", praefix, 1:20)
      lapply(cols, function(col) {
        if (!(col %in% names(daten_stai_state_trait))) {
          stop(paste0("Item-Spalte '", col, "' fehlt in daten_stai_state_trait."))
        }
        ex = stai_item_extrahieren(zeile[[col]], attr(daten_stai_state_trait[[col]], "labels"), skala)
        label_roh = attr(daten_stai_state_trait[[col]], "label")
        list(
          col     = col,
          nr      = as.integer(sub(paste0("^", praefix, "_"), "", col)),
          text    = bereinige_markdown(if (is.null(label_roh)) "" else label_roh),
          wert    = ex$wert,
          antwort = ex$antwort
        )
      })
    }

    state_items = extrahiere_items("stai_state", "state")
    trait_items = extrahiere_items("stai_trait", "trait")

    state_werte = setNames(sapply(state_items, function(x) x$wert), sapply(state_items, function(x) x$col))
    trait_werte = setNames(sapply(trait_items, function(x) x$wert), sapply(trait_items, function(x) x$col))

    state_umgepolt = stai_umpolen(state_werte, names(stai_state_umkehr_items))
    trait_umgepolt = stai_umpolen(trait_werte, names(stai_trait_umkehr_items))

    state_items = lapply(state_items, function(it) c(it, list(umgepolt = unname(state_umgepolt[[it$col]]))))
    trait_items = lapply(trait_items, function(it) c(it, list(umgepolt = unname(trait_umgepolt[[it$col]]))))

    state_score = stai_score(state_umgepolt)
    trait_score = stai_score(trait_umgepolt)

    geschlecht_praefix = if (!is.na(geschlecht) && geschlecht == "weiblich") {
      "frauen"
    } else if (!is.na(geschlecht) && geschlecht == "maennlich") {
      "maenner"
    } else {
      NA_character_
    }

    altersgruppen_suffix  = stai_altersgruppe(alter)
    altersgruppen_fallback = is.na(altersgruppen_suffix)
    if (altersgruppen_fallback) altersgruppen_suffix = "_gesamt"

    tabelle_vorschlag = if (!is.na(geschlecht_praefix)) {
      paste0(geschlecht_praefix, altersgruppen_suffix)
    } else {
      paste0("frauen", altersgruppen_suffix)
    }
    geschlecht_unbekannt = is.na(geschlecht_praefix)

    list(
      typ                     = "ok",
      chiffre                 = chiffre,
      ausfuelldatum           = ausfuelldatum,
      alter                   = alter,
      geschlecht              = geschlecht,
      mehrere_treffer_warnung = mehrere_treffer_warnung,
      state_rohwert           = state_score$rohwert,
      state_missing_n         = state_score$missing_n,
      state_auswertbar        = state_score$auswertbar,
      trait_rohwert           = trait_score$rohwert,
      trait_missing_n         = trait_score$missing_n,
      trait_auswertbar        = trait_score$auswertbar,
      tabelle_vorschlag       = tabelle_vorschlag,
      altersgruppen_fallback  = altersgruppen_fallback,
      geschlecht_unbekannt    = geschlecht_unbekannt,
      state_items             = state_items,
      trait_items             = trait_items
    )
  })

  observeEvent(erg_aktuell(), {
    d = erg_aktuell()
    if (identical(d$typ, "ok")) tabelle_override(d$tabelle_vorschlag)
  })

  observeEvent(input$normtabelle_wahl, {
    req(input$normtabelle_wahl)
    tabelle_override(input$normtabelle_wahl)
  }, ignoreInit = TRUE)

  trait_norm_aktuell = reactive({
    d = erg_aktuell()
    req(identical(d$typ, "ok"))
    if (!isTRUE(d$trait_auswertbar)) return(list(auswertbar = FALSE))

    tab_name = tabelle_override()
    req(!is.null(tab_name))
    tab = stai_normtabellen[[tab_name]]
    req(!is.null(tab))

    lk = stai_normlookup(tab, d$trait_rohwert)
    anomalie_hinweis = if (stai_ist_bekannte_anomalie(tab_name, d$trait_rohwert)) {
      "Dieser Normwert basiert auf einer noch nicht gegengeprueften Tabellenzelle, siehe Dokumentation."
    } else {
      NULL
    }

    list(
      auswertbar          = TRUE,
      gefunden            = lk$gefunden,
      t_wert              = lk$t_wert,
      stanine             = lk$stanine,
      prozentrang         = lk$prozentrang,
      tabelle_verwendet   = tab_name,
      anomalie_hinweis    = anomalie_hinweis
    )
  })

  output$fehler_ui = renderUI({
    req(input$btn_suchen)
    d = erg_aktuell()
    if (!identical(d$typ, "ok")) div(class = "alert-fehler", d$meldung)
  })

  output$warnung_mehrfach_ui = renderUI({
    req(input$btn_suchen)
    d = erg_aktuell()
    if (!identical(d$typ, "ok") || is.null(d$mehrere_treffer_warnung)) return(NULL)
    div(class = "alert-warnung",
      paste0("Mehrere Ausfuellungen gefunden (", d$mehrere_treffer_warnung$n,
             " Eintraege). Angezeigt wird die neueste.")
    )
  })

  output$warnung_normtabelle_ui = renderUI({
    req(input$btn_suchen)
    d = erg_aktuell()
    if (!identical(d$typ, "ok") || !isTRUE(d$geschlecht_unbekannt)) return(NULL)
    div(class = "alert-warnung",
      "Geschlecht nicht eindeutig zuordenbar. Bitte Normtabelle manuell pruefen und auswaehlen."
    )
  })

  output$normtabelle_auswahl_ui = renderUI({
    req(input$btn_suchen)
    d = erg_aktuell()
    if (!identical(d$typ, "ok")) return(NULL)

    div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "Normtabelle (Trait-Skala)"),
      selectInput("normtabelle_wahl", label = "Verwendete Normtabelle",
                  choices  = names(stai_normtabellen_dateien),
                  selected = d$tabelle_vorschlag, width = "100%")
    )
  })

  output$ergebnis_ui = renderUI({
    req(input$btn_suchen)
    d = erg_aktuell()
    if (!identical(d$typ, "ok")) return(NULL)
    tn = trait_norm_aktuell()

    kopfzeile = div(class = "meta-block",
      tags$strong("Chiffre: "), d$chiffre,
      tags$span("   |   ", style = "color:#ccc;"),
      tags$strong("Ausfuelldatum: "), d$ausfuelldatum,
      tags$span("   |   ", style = "color:#ccc;"),
      tags$strong("Alter: "), if (is.na(d$alter)) "nicht auswertbar" else d$alter,
      tags$span("   |   ", style = "color:#ccc;"),
      tags$strong("Geschlecht: "), if (is.na(d$geschlecht)) "nicht zuordenbar" else d$geschlecht
    )

    state_karte = div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "State-Angst (aktueller Zustand)"),
      if (isTRUE(d$state_auswertbar)) {
        tagList(
          div(class = "rohwert-anzeige", paste0(as.integer(d$state_rohwert), " / 80")),
          div(class = "rohwert-hinweis",
              "kein Normvergleich moeglich, Skala zur Veraenderungsmessung konstruiert")
        )
      } else {
        div(class = "rohwert-anzeige", "nicht auswertbar (mehr als 2 fehlende Antworten)")
      }
    )

    trait_karte = div(class = "abschnitt-karte",
      div(class = "abschnitt-titel", "Trait-Angst (allgemeine Aengstlichkeit)"),
      if (!isTRUE(d$trait_auswertbar)) {
        div(class = "rohwert-anzeige", "nicht auswertbar (mehr als 2 fehlende Antworten)")
      } else {
        tagList(
          div(class = "rohwert-anzeige", paste0(as.integer(d$trait_rohwert), " / 80")),
          if (isTRUE(tn$gefunden)) {
            div(class = "normtabelle-info",
              tags$strong("T-Wert: "), format(tn$t_wert),
              tags$span("   |   ", style = "color:#ccc;"),
              tags$strong("Stanine: "), format(tn$stanine),
              tags$span("   |   ", style = "color:#ccc;"),
              tags$strong("Prozentrang: "), format(tn$prozentrang),
              tags$span("   |   ", style = "color:#ccc;"),
              tags$em(paste0("Normtabelle: ", tn$tabelle_verwendet))
            )
          } else {
            div(class = "normtabelle-info", "kein Normwert ausgewiesen (Bereich der Stichprobe verlassen)")
          },
          if (!is.null(tn$anomalie_hinweis)) div(class = "alert-warnung", tn$anomalie_hinweis),
          if (isTRUE(d$altersgruppen_fallback)) {
            div(class = "alert-warnung",
              paste0("Alter ausserhalb der normierten Altersgruppen, es wird die Gesamttabelle fuer ",
                     if (grepl("^frauen", tn$tabelle_verwendet)) "Frauen" else "Maenner", " verwendet.")
            )
          },
          if (isTRUE(tn$gefunden)) plotOutput("prozentrang_plot", height = "110px")
        )
      }
    )

    item_liste = function(items, titel) {
      unresolved_n = sum(sapply(items, function(x) is.na(x$wert)))
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", titel),
        if (unresolved_n > 0) {
          div(class = "alert-warnung", paste0(unresolved_n, " von 20 ", titel, " nicht zuordenbar."))
        },
        lapply(items, function(it) {
          unresolved = is.na(it$wert) || is.na(it$antwort)
          antwort_anzeige = if (unresolved) "nicht zuordenbar" else it$antwort
          stufe_key = if (!unresolved && !is.na(it$umgepolt) && as.character(it$umgepolt) %in% names(STAI_BADGE_FARBEN)) {
            as.character(it$umgepolt)
          } else {
            NA_character_
          }
          badge_klasse = if (unresolved || is.na(stufe_key)) {
            "antwort-badge antwort-badge-fehlend"
          } else {
            paste0("antwort-badge antwort-badge-", stufe_key)
          }
          div(class = "item-zeile",
            span(class = "item-nr", it$nr),
            span(class = "item-text", it$text),
            span(class = "item-antwort",
              tags$span(class = badge_klasse, antwort_anzeige)
            )
          )
        })
      )
    }

    tagList(
      kopfzeile,
      div(class = "skalen-reihe", state_karte, trait_karte),
      item_liste(d$trait_items, "Trait-Items"),
      item_liste(d$state_items, "State-Items"),
      div(class = "disclaimer-block", STAI_DISCLAIMER)
    )
  })

  output$prozentrang_plot = renderPlot({
    tn = trait_norm_aktuell()
    req(isTRUE(tn$gefunden))
    stai_prozentrang_plot(tn$prozentrang)
  })

  output$download_word = downloadHandler(
    filename = function() {
      d = tryCatch(erg_aktuell(), error = function(e) NULL)
      chiffre_esc = if (is.list(d) && identical(d$typ, "ok") && nchar(d$chiffre) > 0) {
        gsub("[^A-Za-z0-9_-]", "_", d$chiffre)
      } else {
        "export"
      }
      ausfuelldatum_fn = tryCatch(
        format(as.Date(d$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d"),
        error = function(e) format(Sys.Date(), "%Y%m%d")
      )
      if (is.na(ausfuelldatum_fn) || length(ausfuelldatum_fn) == 0) {
        ausfuelldatum_fn = format(Sys.Date(), "%Y%m%d")
      }
      paste0("STAI_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
    },
    content = function(file) {
      d = tryCatch(erg_aktuell(), error = function(e) NULL)
      daten_ok = is.list(d) && identical(d$typ, "ok")
      if (!daten_ok) {
        doc = read_docx()
        doc = body_add_par(doc,
          "Kein Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Auswerten' klicken.",
          style = "Normal")
        print(doc, target = file)
        return()
      }

      tn = trait_norm_aktuell()

      erg = c(d, list(
        trait_norm_gefunden       = isTRUE(tn$gefunden),
        trait_t_wert              = tn$t_wert,
        trait_stanine             = tn$stanine,
        trait_prozentrang         = tn$prozentrang,
        tabelle_verwendet         = tn$tabelle_verwendet,
        tabelle_anomalie_hinweis  = tn$anomalie_hinweis
      ))

      doc = tryCatch(
        erstelle_stai_docx(erg),
        error = function(e) {
          err_doc = read_docx()
          body_add_par(err_doc,
            paste0("Fehler beim Erstellen des Word-Dokuments: ", e$message),
            style = "Normal")
        }
      )
      print(doc, target = file)
    }
  )
}


# Start ####

shinyApp(ui, server)