# Präambel ####

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

AKZENT_FARBE = "#8B2635"

SKALEN_NAMEN = c(
  A = "Kontrollieren, Wiederholen, Denken nach einer Handlung",
  B = "Waschen, Reinigen",
  C = "Ordnen",
  D = "Zählen, Berühren, Sprechen",
  E = "Denken von Worten, Bildern, Gedankenketten",
  F = "Gedanken, sich selbst/anderen ein Leid zuzufügen"
)

KENNWERT_NAMEN = c(
  A = "Skala A - Kontrollieren, Wiederholen, Denken nach einer Handlung",
  B = "Skala B - Waschen, Reinigen",
  C = "Skala C - Ordnen",
  D = "Skala D - Zählen, Berühren, Sprechen",
  E = "Skala E - Denken von Worten, Bildern, Gedankenketten",
  F = "Skala F - Gedanken, sich selbst/anderen ein Leid zuzufügen",
  G = "Gesamtskala",
  P1 = "Prüfskala P1",
  P2 = "Prüfskala P2",
  P3 = "Prüfskala P3",
  P4 = "Prüfskala P4"
)

TABELLE_KONFIDENZINTERVALLE = data.frame(
  skala   = c("A","B","C","D","E","F","G","P1","P2","P3","P4"),
  r_tt    = c(.88,.96,.94,.95,.86,.78,.93,.86,.90,.90,.91),
  s_e     = c(0.69,0.40,0.49,0.45,0.75,0.94,0.53,0.75,0.63,0.63,0.60),
  cl_5proz = c(1.35,0.78,0.96,0.87,1.47,1.84,1.03,1.47,1.23,1.23,1.17),
  cl_1proz = c(1.78,1.03,1.26,1.15,1.93,2.42,1.36,1.93,1.62,1.62,1.54),
  stringsAsFactors = FALSE
)

PRUEFSKALEN_D_CRIT_5PROZ  = 3
PRUEFSKALEN_D_CRIT_1PROZ  = 4
PRUEFSKALEN_D_CRIT_01PROZ = 5

HZI_DISCLAIMER = paste0(
  "Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
  "keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
  "Angaben zu Normal- und Extrembereich sowie die 54%-Markierung des Originalprofilbogens ",
  "sind in dieser digitalen Auswertung nicht abgebildet, da hierfuer keine im Manual ",
  "textuell belegten Zahlenwerte vorliegen."
)

PRUEFSKALA_ERKLAERUNG = paste0(
  "Die Prüfskalen P1–P4 sind keine inhaltlichen Symptomskalen wie A–F, sondern fassen die Items ",
  "aller sechs Skalen auf derselben Schwierigkeitsstufe zusammen (z. B. P1 = alle Stufe-1-Items ",
  "über alle Skalen hinweg). Sie dienen als Kontrollwert für die Konsistenz des Antwortverhaltens: ",
  "weichen die vier Prüfskalen stark voneinander ab, deutet dies auf ein untypisches Antwortmuster ",
  "hin (HZI-Non-Skalen-Typ), nicht auf ein bestimmtes Symptombild."
)

#### Infrastruktur ####

PFAD_DOWNLOAD_SKRIPT     = "../API/get_data_hzi.R"
PFAD_PSEUDONYM_SKRIPT    = "../get_pseudo.R"
PFAD_NORMTABELLEN_ORDNER = "./normtabellen"

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_ORDNER = normalizePath(absPath(PFAD_NORMTABELLEN_ORDNER), mustWork = FALSE)

app_css = "
.input-panel {
  display: flex;
  align-items: center;
  gap: 16px;
  flex-wrap: wrap;
  padding: 16px;
  margin-bottom: 20px;
  background: #f5f5f5;
  border-radius: 6px;
}
.btn-laden {
  background-color: #8B2635;
  border-color: #8B2635;
  color: #fff;
}
.btn-laden:hover, .btn-laden:focus {
  background-color: #6f1e2a;
  border-color: #6f1e2a;
  color: #fff;
}
.abschnitt-karte {
  padding: 16px 20px;
  margin-bottom: 18px;
  border: 1px solid #ddd;
  border-radius: 6px;
  background: #fff;
}
.abschnitt-titel {
  font-size: 1.15em;
  font-weight: 700;
  color: #8B2635;
  margin-bottom: 12px;
}
.alert-fehler {
  padding: 12px 16px;
  margin-bottom: 14px;
  background: #f8d7da;
  border: 1px solid #c0392b;
  border-radius: 5px;
  color: #58151c;
}
.alert-warnung {
  padding: 12px 16px;
  margin-bottom: 14px;
  background: #fff3cd;
  border: 1px solid #b8860b;
  border-radius: 5px;
  color: #6b5100;
}
.item-zeile {
  display: flex;
  align-items: flex-start;
  gap: 10px;
  padding: 4px 0;
  border-bottom: 1px solid #eee;
}
.item-nr {
  font-weight: 600;
  min-width: 60px;
  color: #8B2635;
  flex-shrink: 0;
}
.item-text {
  flex: 1;
}
.badge {
  display: inline-block;
  align-self: flex-start;
  flex-shrink: 0;
  padding: 2px 10px;
  border-radius: 12px;
  font-size: 0.85em;
  font-weight: 600;
  line-height: 1.4;
  white-space: nowrap;
}
.badge-positiv {
  background: #8B2635;
  color: #fff;
}
.badge-negativ {
  background: #e0e0e0;
  color: #444;
}
.badge-fehlend {
  background: #fff3cd;
  color: #6b5100;
  border: 1px solid #b8860b;
}
table.tabelle-werte {
  width: 100%;
  border-collapse: collapse;
}
table.tabelle-werte th, table.tabelle-werte td {
  padding: 6px 10px;
  border-bottom: 1px solid #ddd;
  text-align: left;
}
table.tabelle-werte th {
  background: #8B2635;
  color: #fff;
}
"
app_css = gsub("#8B2635", AKZENT_FARBE, app_css, fixed = TRUE)

#### Helper ####

validiere_chiffre = function(chiffre_roh) {
  chiffre = toupper(trimws(chiffre_roh))
  if (!grepl("^[A-Z][0-9]{6}$", chiffre)) {
    return(list(ok = FALSE, typ = "format_fehler", chiffre = chiffre))
  }
  list(ok = TRUE, chiffre = chiffre)
}

extrahiere_item_zuordnung = function(spaltennamen) {
  treffer = regmatches(spaltennamen, regexec("^hzi_(\\d{3})_([a-f])([1-4])$", spaltennamen))
  gefunden = vapply(treffer, function(x) length(x) == 4, logical(1))
  if (sum(gefunden) == 0) {
    stop("Keine Item-Spalten im Muster 'hzi_NNN_[a-f][1-4]' in daten_hzi gefunden.")
  }
  passende = treffer[gefunden]
  data.frame(
    spalte   = spaltennamen[gefunden],
    item_nr  = vapply(passende, function(x) x[2], character(1)),
    skala    = toupper(vapply(passende, function(x) x[3], character(1))),
    stufe    = as.integer(vapply(passende, function(x) x[4], character(1))),
    stringsAsFactors = FALSE
  )
}

ermittle_stimmt_code = function(daten_hzi, spalte) {
  labels = attr(daten_hzi[[spalte]], "labels")
  if (is.null(labels)) {
    stop(sprintf("Item-Spalte '%s': keine Kodierungs-Labels (labelled-Attribut 'labels') gefunden.", spalte))
  }
  namen = trimws(names(labels))
  treffer = which(namen == "stimmt")
  if (length(treffer) == 0) {
    stop(sprintf("Item-Spalte '%s': keine Antwortoption exakt 'stimmt' in den Labels gefunden.", spalte))
  }
  if (length(treffer) > 1) {
    stop(sprintf("Item-Spalte '%s': mehrdeutige Kodierung, mehrere Labels 'stimmt' gefunden.", spalte))
  }
  unname(labels[treffer])
}

bereinige_markdown = function(text) {
  if (is.na(text)) return(text)
  t = text
  # Fuehrende Itemnummerierung entfernen, z. B. "6\. " oder "12. " (redundant zur Itemnummer-Badge)
  t = sub(r"(^\s*\d+\\?[.\)]\s*)", "", t, perl = TRUE)
  # Escapte Markdown-Sonderzeichen entschaerfen, z. B. "\." -> "."
  t = gsub(r"(\\([[:punct:]]))", "\\1", t, perl = TRUE)
  trimws(t)
}

ermittle_item_text = function(daten_hzi, spalte) {
  text = attr(daten_hzi[[spalte]], "label", exact = TRUE)
  if (is.null(text) || length(text) != 1 || is.na(text) || trimws(text) == "") {
    return(NA_character_)
  }
  bereinige_markdown(trimws(text))
}

baue_item_info = function(daten_hzi) {
  item_zuordnung = extrahiere_item_zuordnung(colnames(daten_hzi))
  item_zuordnung$stimmt_code = vapply(
    item_zuordnung$spalte,
    function(sp) ermittle_stimmt_code(daten_hzi, sp),
    numeric(1)
  )
  item_zuordnung$item_text = vapply(
    item_zuordnung$spalte,
    function(sp) ermittle_item_text(daten_hzi, sp),
    character(1)
  )
  item_zuordnung
}

berechne_itemwerte = function(zeile, item_info) {
  werte = vapply(seq_len(nrow(item_info)), function(i) {
    spalte = item_info$spalte[i]
    stimmt_code = item_info$stimmt_code[i]
    roh = zeile[[spalte]][1]
    val = suppressWarnings(as.numeric(roh))
    if (is.na(val)) return(NA_integer_)
    if (val == stimmt_code) 1L else 0L
  }, integer(1))
  item_info$wert = werte
  item_info
}

berechne_rohwerte = function(item_info_mit_werten) {
  zellwerte = item_info_mit_werten %>%
    group_by(skala, stufe) %>%
    summarise(rohwert = sum(wert, na.rm = TRUE), n_fehlend = sum(is.na(wert)), .groups = "drop")

  skalenrohwerte = zellwerte %>%
    group_by(skala) %>%
    summarise(rohwert = sum(rohwert), n_fehlend = sum(n_fehlend), .groups = "drop")

  gesamtrohwert = sum(skalenrohwerte$rohwert)

  pruefskalen = zellwerte %>%
    group_by(stufe) %>%
    summarise(rohwert = sum(rohwert), n_fehlend = sum(n_fehlend), .groups = "drop")

  rohwerte = c(setNames(skalenrohwerte$rohwert, skalenrohwerte$skala), G = gesamtrohwert)
  rohwerte = c(rohwerte, setNames(pruefskalen$rohwert, paste0("P", pruefskalen$stufe)))

  n_fehlend_gesamt = sum(item_info_mit_werten$wert %>% is.na())

  list(
    zellwerte      = zellwerte,
    skalenrohwerte = skalenrohwerte,
    pruefskalen    = pruefskalen,
    rohwerte       = rohwerte,
    gesamtrohwert  = gesamtrohwert,
    n_fehlend      = n_fehlend_gesamt
  )
}

rohwert_zu_stanine = function(tabelle, rohwert) {
  zeile = tabelle[tabelle$rohwert == rohwert, ]
  if (nrow(zeile) == 0) {
    stop(sprintf(
      "Rohwert %s liegt außerhalb des gültigen Bereichs der Normtabelle (%s–%s). Dies deutet auf einen Rechenfehler hin.",
      rohwert, min(tabelle$rohwert, na.rm = TRUE), max(tabelle$rohwert, na.rm = TRUE)
    ))
  }
  zeile$stanine[1]
}

NORM_KEY_ZUORDNUNG = c(
  A = "a", B = "b", C = "c", D = "d", E = "e", F = "f",
  G = "gesamt", P1 = "p1", P2 = "p2", P3 = "p3", P4 = "p4"
)

berechne_stanine_alle = function(rohwerte, normtabellen) {
  namen = names(rohwerte)
  stanine = vapply(namen, function(n) {
    key = NORM_KEY_ZUORDNUNG[[n]]
    tabelle = normtabellen[[key]]
    stanine_wert = rohwert_zu_stanine(tabelle, rohwerte[[n]])
    if (is.na(stanine_wert)) NA_real_ else as.numeric(stanine_wert)
  }, numeric(1))
  names(stanine) = namen
  stanine
}

pruefe_skalenpaar_differenzen = function(stanine_werte, differenzen_tabelle) {
  ergebnisse = lapply(seq_len(nrow(differenzen_tabelle)), function(i) {
    s1 = differenzen_tabelle$skala_1[i]
    s2 = differenzen_tabelle$skala_2[i]
    st1 = stanine_werte[[s1]]
    st2 = stanine_werte[[s2]]
    if (is.null(st1) || is.null(st2) || is.na(st1) || is.na(st2)) return(NULL)
    d = abs(st1 - st2)
    crit5 = differenzen_tabelle$d_crit_5proz[i]
    crit1 = differenzen_tabelle$d_crit_1proz[i]
    if (d < crit5) return(NULL)
    signifikanz_1proz = d >= crit1
    data.frame(
      skala_1 = s1, skala_2 = s2, differenz = d,
      signifikant_1proz = signifikanz_1proz,
      stringsAsFactors = FALSE
    )
  })
  ergebnisse = ergebnisse[!vapply(ergebnisse, is.null, logical(1))]
  if (length(ergebnisse) == 0) return(data.frame())
  do.call(rbind, ergebnisse)
}

formatiere_skalenpaar_text = function(zeile) {
  basis = sprintf(
    "Skala %s unterscheidet sich bedeutsam von Skala %s (Differenz %s, überschreitet kritische Differenz bei p<.05",
    zeile$skala_1, zeile$skala_2, zeile$differenz
  )
  if (isTRUE(zeile$signifikant_1proz)) {
    paste0(basis, ", auch p<.01).")
  } else {
    paste0(basis, ").")
  }
}

pruefskalen_streuung_hinweis = function(stanine_werte) {
  p_werte = stanine_werte[c("P1", "P2", "P3", "P4")]
  p_werte = p_werte[!is.na(p_werte)]
  if (length(p_werte) < 2) return(NULL)
  spanne = max(p_werte) - min(p_werte)
  schwelle = NULL
  if (spanne >= PRUEFSKALEN_D_CRIT_01PROZ) {
    schwelle = list(text = "p<.001", grenze = PRUEFSKALEN_D_CRIT_01PROZ)
  } else if (spanne >= PRUEFSKALEN_D_CRIT_1PROZ) {
    schwelle = list(text = "p<.01", grenze = PRUEFSKALEN_D_CRIT_1PROZ)
  } else if (spanne >= PRUEFSKALEN_D_CRIT_5PROZ) {
    schwelle = list(text = "p<.05", grenze = PRUEFSKALEN_D_CRIT_5PROZ)
  }
  if (is.null(schwelle)) return(NULL)
  list(
    spanne = spanne,
    text = sprintf(
      "Streuung der Prüfskalen: %s Stanine-Punkte, überschreitet die kritische Differenz bei %s — Hinweis auf möglicherweise untypisches Antwortmuster (HZI-Non-Skalen-Typ).",
      spanne, schwelle$text
    )
  )
}

dissimulation_hinweis = function(gesamtrohwert) {
  if (gesamtrohwert < 8 || gesamtrohwert > 145) {
    return(paste0(
      "Gesamtrohwert liegt außerhalb des in der Validierungsstichprobe beobachteten Wertebereichs (8–145) — ",
      "möglicher Hinweis auf verzerrtes Antwortverhalten (Unter- oder Übertreibung)."
    ))
  }
  NULL
}

formatiere_ci_text = function(stanine, cl_5proz) {
  if (is.na(stanine)) return("–")
  sprintf("%s ± %s", stanine, cl_5proz)
}

item_status_text = function(wert) {
  if (is.na(wert)) return("fehlend")
  if (wert == 1) "stimmt" else "stimmt nicht"
}

item_status_klasse = function(wert) {
  if (is.na(wert)) return("badge-fehlend")
  if (wert == 1) "badge-positiv" else "badge-negativ"
}

sortiere_items_pro_skala = function(item_info) {
  item_info$prioritaet = ifelse(is.na(item_info$wert), 3L, ifelse(item_info$wert == 1L, 1L, 2L))
  item_info[order(item_info$skala, item_info$prioritaet, item_info$item_nr), ]
}

sichere_datumsparse = function(text) {
  formate = c("%Y-%m-%d", "%d.%m.%Y", "%Y-%m-%dT%H:%M:%S", "%Y-%m-%d %H:%M:%S")
  for (fmt in formate) {
    d = suppressWarnings(as.Date(text, format = fmt))
    if (!is.na(d)) return(d)
  }
  NA
}

#### Datenaufbereitung ####

ERWARTETE_NORMTABELLEN = list(
  a       = "skala_a_kontrollieren.csv",
  b       = "skala_b_waschen.csv",
  c       = "skala_c_ordnen.csv",
  d       = "skala_d_zaehlen.csv",
  e       = "skala_e_denken.csv",
  f       = "skala_f_selbstfremdschaedigung.csv",
  gesamt  = "gesamtskala.csv",
  p1      = "pruefskala_p1.csv",
  p2      = "pruefskala_p2.csv",
  p3      = "pruefskala_p3.csv",
  p4      = "pruefskala_p4.csv"
)

if (!dir.exists(PFAD_NORMTABELLEN_ORDNER)) {
  stop(sprintf(
    "Normtabellen-Ordner nicht gefunden. Geprüfter Pfad: '%s'. Bitte die 11 Normtabellen-CSVs dort ablegen.",
    PFAD_NORMTABELLEN_ORDNER
  ))
}

normtabellen = list()
for (schluessel in names(ERWARTETE_NORMTABELLEN)) {
  dateiname = ERWARTETE_NORMTABELLEN[[schluessel]]
  dateipfad = file.path(PFAD_NORMTABELLEN_ORDNER, dateiname)
  if (!file.exists(dateipfad)) {
    stop(sprintf(
      "Normtabelle fehlt: '%s'. Erwarteter Pfad: '%s'.",
      dateiname, dateipfad
    ))
  }
  normtabellen[[schluessel]] = read_csv(
    dateipfad,
    col_types = cols(rohwert = col_integer(), stanine = col_integer()),
    show_col_types = FALSE
  )
}

pfad_differenzen = file.path(PFAD_NORMTABELLEN_ORDNER, "kritische_differenzen_skalenpaare.csv")
if (!file.exists(pfad_differenzen)) {
  stop(sprintf(
    "Normtabelle fehlt: 'kritische_differenzen_skalenpaare.csv'. Erwarteter Pfad: '%s'.",
    pfad_differenzen
  ))
}
normtabellen$differenzen = read_csv(
  pfad_differenzen,
  col_types = cols(
    skala_1 = col_character(),
    skala_2 = col_character(),
    d_crit_5proz = col_double(),
    d_crit_1proz = col_double()
  ),
  show_col_types = FALSE
)

#### UI ####

ui = fluidPage(
  tags$head(tags$style(HTML(app_css))),
  titlePanel("HZI (Langform) — Auswertung"),
  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("ergebnis_ui")
)

#### Word-Export ####

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

  doc = doc %>% body_add_fpar(fpar(
    ftext(sprintf("HZI (Langform) — Auswertung — Chiffre %s — Ausfülldatum: %s",
                   erg$chiffre, erg$ausfuelldatum_anzeige),
          fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18))
  ))

  if (!is.null(erg$ausfuelldatum_hinweis)) {
    doc = doc %>% body_add_fpar(fpar(ftext(erg$ausfuelldatum_hinweis, fp_text(italic = TRUE, font.size = 10))))
  }

  if (length(erg$warnungen) > 0) {
    doc = doc %>% body_add_fpar(fpar(ftext("Hinweise", fp_text(bold = TRUE, font.size = 14))))
    for (w in erg$warnungen) {
      doc = doc %>% body_add_fpar(fpar(ftext(w, fp_text(color = "#B8860B", font.size = 11))))
    }
  }

  if (!is.null(erg$mehrfach_hinweis)) {
    doc = doc %>% body_add_fpar(fpar(ftext(erg$mehrfach_hinweis, fp_text(color = "#B8860B", font.size = 11))))
  }

  bild_pfad_profil = tempfile(fileext = ".png")
  ggsave(bild_pfad_profil, plot = erg$plot_profil, width = 7, height = 3.5, dpi = 150)
  doc = doc %>% body_add_img(src = bild_pfad_profil, width = 6, height = 3)

  doc = doc %>% body_add_fpar(fpar(ftext(PRUEFSKALA_ERKLAERUNG, fp_text(italic = TRUE, font.size = 9))))

  bild_pfad_pruef = tempfile(fileext = ".png")
  ggsave(bild_pfad_pruef, plot = erg$plot_pruefskalen, width = 7, height = 3.5, dpi = 150)
  doc = doc %>% body_add_img(src = bild_pfad_pruef, width = 6, height = 3)

  doc = doc %>% body_add_fpar(fpar(ftext("Werteübersicht", fp_text(bold = TRUE, font.size = 14))))
  for (i in seq_len(nrow(erg$tabelle_werte))) {
    zeile = erg$tabelle_werte[i, ]
    doc = doc %>% body_add_fpar(fpar(ftext(sprintf(
      "%s — Rohwert: %s, Stanine: %s, ± CL(5%%): %s",
      zeile$name, zeile$rohwert, zeile$stanine_anzeige, zeile$ci_text
    ), fp_text(font.size = 11))))
  }

  doc = doc %>% body_add_fpar(fpar(ftext("Items pro Skala", fp_text(bold = TRUE, font.size = 14))))
  items_sortiert = sortiere_items_pro_skala(erg$item_info)
  status_farbe = c(stimmt = AKZENT_FARBE, "stimmt nicht" = "#666666", fehlend = "#B8860B")
  for (sk in names(SKALEN_NAMEN)) {
    doc = doc %>% body_add_fpar(fpar(ftext(
      sprintf("Skala %s – %s", sk, SKALEN_NAMEN[[sk]]), fp_text(bold = TRUE, font.size = 12)
    )))
    items_sk = items_sortiert[items_sortiert$skala == sk, ]
    for (i in seq_len(nrow(items_sk))) {
      zeile = items_sk[i, ]
      text_anzeige = if (is.na(zeile$item_text)) {
        sprintf("Item %s (kein Itemtext im Export vorhanden)", zeile$item_nr)
      } else {
        zeile$item_text
      }
      status = item_status_text(zeile$wert)
      doc = doc %>% body_add_fpar(fpar(
        ftext(sprintf("%s — %s — ", zeile$item_nr, text_anzeige), fp_text(font.size = 10)),
        ftext(status, fp_text(bold = TRUE, font.size = 10, color = status_farbe[[status]]))
      ))
    }
  }

  doc = doc %>% body_add_fpar(fpar(ftext(HZI_DISCLAIMER, fp_text(italic = TRUE, font.size = 9))))

  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)))
    }
  })

  ergebnis_r = eventReactive(input$btn_suchen, {

    chiffre_roh = input$chiffre
    if (is.null(chiffre_roh) || (nchar(trimws(input$pseudonym)) == 0 && trimws(chiffre_roh) == "")) {
      return(list(ok = FALSE, meldung = "Bitte eine Patientenchiffre eingeben."))
    }

    validierung = validiere_chiffre(chiffre_roh)
    if (!validierung$ok) {
      return(list(ok = FALSE, meldung = sprintf(
        "Chiffre '%s' hat kein gültiges Format (erwartet: ein Buchstabe gefolgt von 6 Ziffern, z.B. P000123).",
        validierung$chiffre
      )))
    }
    chiffre = validierung$chiffre

    if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
      return(list(ok = FALSE, meldung = sprintf(
        "Download-Skript nicht gefunden. Geprüfter Pfad: '%s'.", PFAD_DOWNLOAD_SKRIPT
      )))
    }
    if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
      return(list(ok = FALSE, meldung = sprintf(
        "Pseudonym-Skript nicht gefunden. Geprüfter Pfad: '%s'.", PFAD_PSEUDONYM_SKRIPT
      )))
    }

    ok = tryCatch({
      source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
      list(ok = TRUE)
    }, error = function(e) list(ok = FALSE, msg = e$message))
    if (!ok$ok) {
      return(list(ok = FALSE, meldung = sprintf("Fehler beim Ausführen des Download-Skripts: %s", ok$msg)))
    }

    db_ordner = NULL
    kandidat = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT))
    for (i in 1:5) {
      if (file.exists(file.path(kandidat, "pseudonyme.db"))) {
        db_ordner = kandidat
        break
      }
      neuer_kandidat = dirname(kandidat)
      if (neuer_kandidat == kandidat) break
      kandidat = neuer_kandidat
    }
    if (is.null(db_ordner)) {
      return(list(ok = FALSE, meldung = "Datei 'pseudonyme.db' konnte in den übergeordneten Verzeichnissen des Pseudonym-Skripts nicht gefunden werden."))
    }

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

    ok2 = 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 (!ok2$ok) {
      return(list(ok = FALSE, meldung = sprintf("Fehler beim Ausführen des Pseudonym-Skripts: %s", ok2$msg)))
    }

    if (!exists("daten_hzi", envir = .GlobalEnv)) {
      return(list(ok = FALSE, meldung = "Objekt 'daten_hzi' wurde nach dem Sourcen des Download-Skripts nicht gefunden."))
    }
    if (!exists("pseudo", envir = .GlobalEnv)) {
      return(list(ok = FALSE, meldung = "Objekt 'pseudo' wurde nach dem Sourcen des Pseudonym-Skripts nicht gefunden."))
    }
    daten_hzi = get("daten_hzi", envir = .GlobalEnv)
    pseudo = get("pseudo", envir = .GlobalEnv)

    treffer_pseudo = pseudo[toupper(trimws(pseudo$chiffre)) == chiffre, ]
    if (nrow(treffer_pseudo) == 0) {
      return(list(ok = FALSE, meldung = sprintf("Keine Zuordnung für Chiffre '%s' in der Pseudonym-Tabelle gefunden.", chiffre)))
    }
    session_id = treffer_pseudo$pseudonym[1]
    if (nchar(trimws(input$pseudonym)) > 0) session_id = trimws(input$pseudonym)

    treffer_daten = daten_hzi[daten_hzi$session == session_id |
                                (("pseudonym" %in% colnames(daten_hzi)) && daten_hzi$pseudonym == session_id), ]
    if (nrow(treffer_daten) == 0 && "pseudonym" %in% colnames(daten_hzi)) {
      treffer_daten = daten_hzi[daten_hzi$pseudonym == session_id, ]
    }
    if (nrow(treffer_daten) == 0 && "session" %in% colnames(daten_hzi)) {
      treffer_daten = daten_hzi[daten_hzi$session == session_id, ]
    }
    if (nrow(treffer_daten) == 0) {
      return(list(ok = FALSE, meldung = sprintf("Keine HZI-Antworten für Chiffre '%s' (Session '%s') in den Exportdaten gefunden.", chiffre, session_id)))
    }

    mehrfach_hinweis = NULL
    if (nrow(treffer_daten) > 1) {
      if ("created" %in% colnames(treffer_daten)) {
        treffer_daten = treffer_daten[order(treffer_daten$created, decreasing = TRUE), ]
        treffer_daten = treffer_daten[1, ]
        mehrfach_hinweis = "Hinweis: Der Bogen wurde mehrfach ausgefüllt. Es wurde die Auswertung mit dem neuesten Ausfülldatum verwendet."
      } else {
        treffer_daten = treffer_daten[1, ]
        mehrfach_hinweis = "Hinweis: Der Bogen wurde mehrfach ausgefüllt. Es konnte kein Ausfülldatum zur Auswahl der neuesten Version ermittelt werden, es wurde der erste Treffer verwendet."
      }
    }

    ausfuelldatum_hinweis = NULL
    if ("created" %in% colnames(treffer_daten)) {
      ausfuelldatum = sichere_datumsparse(as.character(treffer_daten$created[1]))
      if (is.na(ausfuelldatum)) {
        ausfuelldatum = Sys.Date()
        ausfuelldatum_hinweis = "Ausfülldatum nicht in Exportdaten gefunden, Downloaddatum verwendet."
      }
    } else {
      ausfuelldatum = Sys.Date()
      ausfuelldatum_hinweis = "Ausfülldatum nicht in Exportdaten gefunden, Downloaddatum verwendet."
    }

    item_info_roh = tryCatch(
      baue_item_info(daten_hzi),
      error = function(e) e
    )
    if (inherits(item_info_roh, "error")) {
      return(list(ok = FALSE, meldung = sprintf("Fehler bei der Item-Zuordnung: %s", conditionMessage(item_info_roh))))
    }

    item_info = berechne_itemwerte(treffer_daten, item_info_roh)
    n_fehlend = sum(is.na(item_info$wert))

    ergebnis_rohwerte = berechne_rohwerte(item_info)
    stanine_werte = tryCatch(
      berechne_stanine_alle(ergebnis_rohwerte$rohwerte, normtabellen),
      error = function(e) e
    )
    if (inherits(stanine_werte, "error")) {
      return(list(ok = FALSE, meldung = sprintf("Fehler bei der Stanine-Umrechnung: %s", conditionMessage(stanine_werte))))
    }

    skalenpaar_differenzen = pruefe_skalenpaar_differenzen(stanine_werte, normtabellen$differenzen)
    streuung_hinweis = pruefskalen_streuung_hinweis(stanine_werte)
    dissim_hinweis = dissimulation_hinweis(ergebnis_rohwerte$gesamtrohwert)

    warnungen = c()
    if (!is.null(dissim_hinweis)) warnungen = c(warnungen, dissim_hinweis)
    if (!is.null(streuung_hinweis)) warnungen = c(warnungen, streuung_hinweis$text)
    if (nrow(skalenpaar_differenzen) > 0) {
      for (i in seq_len(nrow(skalenpaar_differenzen))) {
        warnungen = c(warnungen, formatiere_skalenpaar_text(skalenpaar_differenzen[i, ]))
      }
    }
    if (n_fehlend > 0) {
      warnungen = c(warnungen, sprintf(
        "%s Item(s) wurden nicht beantwortet (fehlende Werte) und wurden bei der Rohwertberechnung nicht mitgezählt.",
        n_fehlend
      ))
    }

    tabelle_werte = data.frame(
      kennwert = names(stanine_werte),
      stringsAsFactors = FALSE
    )
    tabelle_werte$name = KENNWERT_NAMEN[tabelle_werte$kennwert]
    tabelle_werte$rohwert = ergebnis_rohwerte$rohwerte[tabelle_werte$kennwert]
    tabelle_werte$stanine_num = stanine_werte[tabelle_werte$kennwert]
    tabelle_werte$stanine_anzeige = ifelse(is.na(tabelle_werte$stanine_num), "–", as.character(tabelle_werte$stanine_num))
    tabelle_werte = merge(tabelle_werte, TABELLE_KONFIDENZINTERVALLE, by.x = "kennwert", by.y = "skala", sort = FALSE)
    tabelle_werte$ci_text = mapply(formatiere_ci_text, tabelle_werte$stanine_num, tabelle_werte$cl_5proz)
    reihenfolge = c("A","B","C","D","E","F","G","P1","P2","P3","P4")
    tabelle_werte = tabelle_werte[match(reihenfolge, tabelle_werte$kennwert), ]

    list(
      ok = TRUE,
      chiffre = chiffre,
      ausfuelldatum = ausfuelldatum,
      ausfuelldatum_anzeige = format(ausfuelldatum, "%d.%m.%Y"),
      ausfuelldatum_hinweis = ausfuelldatum_hinweis,
      mehrfach_hinweis = mehrfach_hinweis,
      rohwerte = ergebnis_rohwerte$rohwerte,
      stanine_werte = stanine_werte,
      tabelle_werte = tabelle_werte,
      warnungen = warnungen,
      item_info = item_info
    )
  })

  baue_profil_plot = function(erg) {
    daten = data.frame(
      skala = factor(names(SKALEN_NAMEN), levels = names(SKALEN_NAMEN)),
      stanine = as.numeric(erg$stanine_werte[names(SKALEN_NAMEN)])
    )
    ggplot(daten, aes(x = skala, y = stanine)) +
      geom_hline(yintercept = 5, linetype = "dashed", color = "grey40") +
      annotate("text", x = -Inf, y = 5.3, label = "Mittelwert Normstichprobe", hjust = -0.05, size = 3, color = "grey40") +
      geom_col(fill = AKZENT_FARBE, width = 0.5, na.rm = TRUE) +
      scale_y_continuous(limits = c(0, 9), breaks = 1:9) +
      labs(x = "Skala", y = "Stanine", title = "Profil Skalen A–F") +
      theme_minimal(base_size = 12)
  }

  baue_pruefskalen_plot = function(erg) {
    daten = data.frame(
      skala = factor(c("P1","P2","P3","P4"), levels = c("P1","P2","P3","P4")),
      stanine = as.numeric(erg$stanine_werte[c("P1","P2","P3","P4")])
    )
    ggplot(daten, aes(x = skala, y = stanine)) +
      geom_hline(yintercept = 5, linetype = "dashed", color = "grey40") +
      annotate("text", x = -Inf, y = 5.3, label = "Mittelwert Normstichprobe", hjust = -0.05, size = 3, color = "grey40") +
      geom_col(fill = AKZENT_FARBE, width = 0.5, na.rm = TRUE) +
      scale_y_continuous(limits = c(0, 9), breaks = 1:9) +
      labs(x = "Prüfskala", y = "Stanine", title = "Profil Prüfskalen P1–P4") +
      theme_minimal(base_size = 12)
  }

  baue_gesamt_plot = function(erg) {
    stanine_g = as.numeric(erg$stanine_werte["G"])
    daten = data.frame(x = 1:9, y = 1)
    ggplot(daten, aes(x = x, y = y)) +
      geom_col(fill = "grey85", width = 1, color = "white") +
      geom_col(data = data.frame(x = stanine_g, y = 1), aes(x = x, y = y), fill = AKZENT_FARBE, width = 1) +
      scale_x_continuous(breaks = 1:9, limits = c(0.5, 9.5)) +
      labs(x = "Stanine", y = NULL, title = "Gesamtskala G") +
      theme_minimal(base_size = 12) +
      theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())
  }

  output$ergebnis_ui = renderUI({
    erg = ergebnis_r()
    if (is.null(erg)) return(NULL)

    if (!isTRUE(erg$ok)) {
      return(div(class = "alert-fehler", erg$meldung))
    }

    blocks = list()

    if (!is.null(erg$mehrfach_hinweis)) {
      blocks = c(blocks, list(div(class = "alert-warnung", erg$mehrfach_hinweis)))
    }
    if (!is.null(erg$ausfuelldatum_hinweis)) {
      blocks = c(blocks, list(div(class = "alert-warnung", erg$ausfuelldatum_hinweis)))
    }
    if (length(erg$warnungen) > 0) {
      blocks = c(blocks, list(
        div(class = "abschnitt-karte",
          div(class = "abschnitt-titel", "Hinweise"),
          tags$ul(lapply(erg$warnungen, function(w) tags$li(class = "alert-warnung", w)))
        )
      ))
    }

    items_sortiert = sortiere_items_pro_skala(erg$item_info)

    blocks = c(blocks, list(
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Profil Skalen A–F"),
        plotOutput("plot_profil", height = "320px")
      ),
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Gesamtskala"),
        plotOutput("plot_gesamt", height = "180px"),
        p(sprintf("Rohwert: %s, Stanine: %s, ± CL(5%%): %s",
                   erg$rohwerte[["G"]],
                   ifelse(is.na(erg$stanine_werte[["G"]]), "–", erg$stanine_werte[["G"]]),
                   erg$tabelle_werte[erg$tabelle_werte$kennwert == "G", "ci_text"]))
      ),
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Prüfskalen P1–P4"),
        p(style = "font-style: italic; color: #555; font-size: 0.9em;", PRUEFSKALA_ERKLAERUNG),
        tags$table(class = "tabelle-werte",
          tags$thead(tags$tr(
            tags$th("Prüfskala"), tags$th("Rohwert"), tags$th("Stanine"), tags$th("± CL (5%)")
          )),
          tags$tbody(
            lapply(c("P1", "P2", "P3", "P4"), function(k) {
              zeile = erg$tabelle_werte[erg$tabelle_werte$kennwert == k, ]
              tags$tr(
                tags$td(zeile$name), tags$td(zeile$rohwert),
                tags$td(zeile$stanine_anzeige), tags$td(zeile$ci_text)
              )
            })
          )
        ),
        plotOutput("plot_pruefskalen", height = "320px")
      ),
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Werteübersicht"),
        tableOutput("tabelle_werte")
      ),
      div(class = "abschnitt-karte",
        div(class = "abschnitt-titel", "Items pro Skala"),
        lapply(names(SKALEN_NAMEN), function(sk) {
          items_sk = items_sortiert[items_sortiert$skala == sk, ]
          tags$details(
            tags$summary(sprintf("Skala %s – %s (Rohwert: %s)", sk, SKALEN_NAMEN[[sk]], erg$rohwerte[[sk]])),
            lapply(seq_len(nrow(items_sk)), function(i) {
              zeile = items_sk[i, ]
              text_anzeige = if (is.na(zeile$item_text)) {
                sprintf("Item %s (kein Itemtext im Export vorhanden)", zeile$item_nr)
              } else {
                zeile$item_text
              }
              div(class = "item-zeile",
                span(class = "item-nr", zeile$item_nr),
                span(class = "item-text", text_anzeige),
                span(class = paste("badge", item_status_klasse(zeile$wert)), item_status_text(zeile$wert))
              )
            })
          )
        })
      )
    ))

    div(blocks)
  })

  output$plot_profil = renderPlot({
    erg = ergebnis_r()
    req(erg$ok)
    baue_profil_plot(erg)
  })

  output$plot_pruefskalen = renderPlot({
    erg = ergebnis_r()
    req(erg$ok)
    baue_pruefskalen_plot(erg)
  })

  output$plot_gesamt = renderPlot({
    erg = ergebnis_r()
    req(erg$ok)
    baue_gesamt_plot(erg)
  })

  output$tabelle_werte = renderTable({
    erg = ergebnis_r()
    req(erg$ok)
    anzeige = erg$tabelle_werte[, c("name", "rohwert", "stanine_anzeige", "ci_text")]
    colnames(anzeige) = c("Skala/Kennwert", "Rohwert", "Stanine", "± CL (5%)")
    anzeige
  }, striped = TRUE, bordered = TRUE)

  output$download_word = downloadHandler(
    filename = function() {
      erg = ergebnis_r()
      if (is.null(erg) || !isTRUE(erg$ok)) return("HZI_Auswertung.docx")
      datum_fn = format(erg$ausfuelldatum, "%Y%m%d")
      chiffre_esc = gsub("[^A-Za-z0-9]", "", erg$chiffre)
      paste0("HZI_", chiffre_esc, "_", datum_fn, ".docx")
    },
    content = function(file) {
      erg = ergebnis_r()
      req(erg$ok)
      erg$plot_profil = baue_profil_plot(erg)
      erg$plot_pruefskalen = baue_pruefskalen_plot(erg)
      doc = erstelle_hzi_docx(erg)
      print(doc, target = file)
    }
  )
}

#### Start ####

shinyApp(ui = ui, server = server)