Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
946
SEK-ES/app.R
Normal file
946
SEK-ES/app.R
Normal file
|
|
@ -0,0 +1,946 @@
|
|||
# Präambel ####
|
||||
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_sekes.R"
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
||||
|
||||
SEKES_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Fuer den SEK-ES liegen laut Verfahrensdokumentation ",
|
||||
"aktuell keine validierten Normwerte vor; die angegebenen Vergleichswerte sind ",
|
||||
"deskriptive Kennwerte der Validierungsstichprobe (Stand 2014). Die Interpretation ",
|
||||
"obliegt der behandelnden Person."
|
||||
)
|
||||
|
||||
SEKES_ROHWERT_HINWEIS = paste0(
|
||||
"Rohwert-Interpretation der Kompetenzitems (Teil B) und der Teil-A-Items ",
|
||||
"(PANAS, Zusatzskalen) noch nicht mit Testdatensatz verifiziert."
|
||||
)
|
||||
|
||||
SEKES_SKALA4X_HINWEIS = paste0(
|
||||
"Hoehere Werte = variableres Kompetenzniveau ueber die untersuchten Emotionen hinweg."
|
||||
)
|
||||
|
||||
SEKES_ZUSATZSKALEN_HINWEIS = paste0(
|
||||
"Diese Zusatzskalen (Bewaeltigungs-Emotionen, EMO-Check Gesamt) sind aus der ",
|
||||
"Item-Skalen-Zuordnung rekonstruiert, ihr Verwendungszweck ueber die reine ",
|
||||
"Summenbildung hinaus ist in der Verfahrensdokumentation nicht belegt. Auch die ",
|
||||
"verwendete Basis-Skala (1-5) ist eine Annahme, keine dokumentierte Vorgabe."
|
||||
)
|
||||
|
||||
# Reihenfolge und Konfiguration der acht Bloecke. B6/B7 tragen ihren Namen in einem
|
||||
# Freitextfeld, B8 (Positive Gefuehle) hat eine andere Item-/Formelstruktur (kein
|
||||
# geometrisches Mittel, kein Aufmerksamkeits-Doppelitem) und ist von Skala 3.x/4.x
|
||||
# ausgeschlossen.
|
||||
SEKES_BLOECKE = list(
|
||||
list(key = "b1", spalte_praefix = "sekes_b1", label_default = "Stress/Anspannung",
|
||||
benannt = FALSE, namensfeld = NULL, positiv = FALSE),
|
||||
list(key = "b2", spalte_praefix = "sekes_b2", label_default = "Angst",
|
||||
benannt = FALSE, namensfeld = NULL, positiv = FALSE),
|
||||
list(key = "b3", spalte_praefix = "sekes_b3", label_default = "Ärger",
|
||||
benannt = FALSE, namensfeld = NULL, positiv = FALSE),
|
||||
list(key = "b4", spalte_praefix = "sekes_b4", label_default = "Traurigkeit",
|
||||
benannt = FALSE, namensfeld = NULL, positiv = FALSE),
|
||||
list(key = "b5", spalte_praefix = "sekes_b5", label_default = "Depressive Stimmung",
|
||||
benannt = FALSE, namensfeld = NULL, positiv = FALSE),
|
||||
list(key = "b6", spalte_praefix = "sekes_b6", label_default = "Gefühl X",
|
||||
benannt = TRUE, namensfeld = "sekes_gefuehl_x", positiv = FALSE),
|
||||
list(key = "b7", spalte_praefix = "sekes_b7", label_default = "Gefühl Y",
|
||||
benannt = TRUE, namensfeld = "sekes_gefuehl_y", positiv = FALSE),
|
||||
list(key = "b8", spalte_praefix = "sekes_b8", label_default = "Positive Gefühle",
|
||||
benannt = FALSE, namensfeld = NULL, positiv = TRUE)
|
||||
)
|
||||
names(SEKES_BLOECKE) = sapply(SEKES_BLOECKE, function(b) b$key)
|
||||
|
||||
# Tabelle 2 der Quelle: deskriptive Kennwerte der Validierungsstichprobe (Stand 2014),
|
||||
# KEINE Normwerte. Nur fuer den Screening-Wert (Intensitaet 0-10) vorgesehen.
|
||||
SEKES_REFERENZ_SCREENING = list(
|
||||
b1 = list(kg_m = 6.15, kg_sd = 2.44, eg_m = 7.68, eg_sd = 2.12),
|
||||
b2 = list(kg_m = 2.46, kg_sd = 2.45, eg_m = 5.38, eg_sd = 3.10),
|
||||
b3 = list(kg_m = 4.80, kg_sd = 2.76, eg_m = 5.17, eg_sd = 2.85),
|
||||
b4 = list(kg_m = 2.86, kg_sd = 2.82, eg_m = 6.22, eg_sd = 3.01),
|
||||
b5 = list(kg_m = 1.87, kg_sd = 2.54, eg_m = 5.22, eg_sd = 3.09),
|
||||
b6 = list(kg_m = 2.57, kg_sd = 3.60, eg_m = 4.17, eg_sd = 3.95),
|
||||
b7 = list(kg_m = 0.59, kg_sd = 1.96, eg_m = 1.96, eg_sd = 3.46),
|
||||
b8 = list(kg_m = 7.89, kg_sd = 1.73, eg_m = 5.10, eg_sd = 2.60)
|
||||
)
|
||||
|
||||
# Reihenfolge und Bezeichnung der zehn Skala-3.x/4.x-Kompetenzen. Position 8 jedes
|
||||
# Blocks fliesst NUR in Skala 2.x ein und hat bewusst keine eigene Zeile hier.
|
||||
SEKES_SKALA_3X_NAMEN = c(
|
||||
"3.1" = "Konstruktive Aufmerksamkeitslenkung",
|
||||
"3.2" = "Klarheit",
|
||||
"3.3" = "Verstehen",
|
||||
"3.4" = "Akzeptieren",
|
||||
"3.5" = "Toleranz",
|
||||
"3.6a" = "Akzeptanz/Toleranz (kombiniert)",
|
||||
"3.6b" = "Konfrontationsbereitschaft",
|
||||
"3.7" = "Effektive Selbstunterstützung",
|
||||
"3.8" = "Modifikationserfolg",
|
||||
"3.9" = "Veränderungsbezogene Selbsteffizienz",
|
||||
"3.10" = "Modifikationskompetenz (kombiniert)"
|
||||
)
|
||||
|
||||
# Teil A (PANAS + Zusatzskalen) - Item-Spaltennamen. PANAS-Items 4-23 entsprechen
|
||||
# wortgetreu und in identischer Reihenfolge der deutschen PANAS-20 (Krohne, Egloff,
|
||||
# Kohlmann & Tausch, 1996), die die Verfahrensdokumentation explizit als externes
|
||||
# Korrelat der Kriteriumsvaliditaet nennt - PANAS ist damit ueber eine belegte,
|
||||
# publizierte Konvention auswertbar (Summe der Raenge 1-5, Wertebereich 10-50).
|
||||
SEKES_PANAS_POSITIV_ITEMS = sprintf("sekes_a_%02d", 4:13)
|
||||
SEKES_PANAS_NEGATIV_ITEMS = sprintf("sekes_a_%02d", 14:23)
|
||||
|
||||
# Bewaeltigungs-Emotionen und EMO-Check-Gesamt sind laut Item-Skalen-Zuordnung
|
||||
# eindeutig aus Teil-A-Items zusammengesetzt, aber OHNE externen Zitations-/
|
||||
# Zweckbeleg in der Verfahrensdokumentation (anders als PANAS). Die verwendete
|
||||
# Basis-Skala (1-5, wie PANAS) ist eine Annahme aus Konsistenzgruenden, keine
|
||||
# belegte Vorgabe - siehe SEKES_ZUSATZSKALEN_HINWEIS.
|
||||
SEKES_BEWAELTIGUNG_ITEMS = sprintf("sekes_a_%02d", c(1, 3, 5, 7, 9, 12, 24, 28, 29, 36, 40))
|
||||
SEKES_EMOCHECK_POSITIV_ITEMS = sprintf("sekes_a_%02d",
|
||||
c(1, 3:13, 24, 28, 29, 36, 40:43, 45:47, 49, 50))
|
||||
SEKES_EMOCHECK_NEGATIV_ITEMS = sprintf("sekes_a_%02d",
|
||||
c(2, 14:23, 25:27, 30:35, 37:39, 44, 48))
|
||||
|
||||
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)
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
|
||||
|
||||
# Infrastruktur ####
|
||||
|
||||
# (Pfadaufloesung bereits in der Praeambel erledigt, siehe APP_VERZEICHNIS/absPath.)
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# Ordnet einem rohen mc-Exportwert die 0-4-Kompetenzstufe zu, robust ueber das
|
||||
# labels-Attribut der ORIGINAL-Spalte (nicht von einer gefilterten Zeile lesen).
|
||||
# Kleinster Rohwert -> Stufe 0 ("ueberhaupt nicht"), groesster -> Stufe 4 ("immer").
|
||||
sekes_stufe_aus_item = function(rohwerte, labels_attr) {
|
||||
if (is.null(labels_attr) || length(labels_attr) != 5) {
|
||||
warning("SEK-ES: Labels-Struktur unerwartet (erwartet: 5 Stufen). ",
|
||||
"Rohwert-Interpretation ist NICHT verifiziert, Fallback auf Wert-1 wird verwendet. ",
|
||||
"Bitte mit echtem Testdatensatz gegenpruefen.")
|
||||
return(as.numeric(rohwerte) - 1)
|
||||
}
|
||||
labels_sortiert = sort(labels_attr)
|
||||
stufen_mapping = setNames(seq_along(labels_sortiert) - 1, as.character(labels_sortiert))
|
||||
stufen = stufen_mapping[as.character(as.numeric(rohwerte))]
|
||||
as.numeric(stufen)
|
||||
}
|
||||
|
||||
# Analog zu sekes_stufe_aus_item(), aber 1-basiert statt 0-basiert, weil die
|
||||
# publizierte PANAS-Konvention die rohe 1-5-Likert-Skala direkt summiert
|
||||
# (Wertebereich 10-50 fuer 10 Items), nicht die SEK-ES-interne 0-4-Skala.
|
||||
sekes_rang_aus_item = function(rohwerte, labels_attr) {
|
||||
if (is.null(labels_attr) || length(labels_attr) != 5) {
|
||||
warning("SEK-ES Teil A: Labels-Struktur unerwartet (erwartet: 5 Stufen). ",
|
||||
"Rohwert-Interpretation ist NICHT verifiziert, Rohwert wird unveraendert verwendet. ",
|
||||
"Bitte mit echtem Testdatensatz gegenpruefen.")
|
||||
return(as.numeric(rohwerte))
|
||||
}
|
||||
labels_sortiert = sort(labels_attr)
|
||||
rang_mapping = setNames(seq_along(labels_sortiert), as.character(labels_sortiert))
|
||||
rang = rang_mapping[as.character(as.numeric(rohwerte))]
|
||||
as.numeric(rang)
|
||||
}
|
||||
|
||||
# Summe der Raenge (1-5) ueber eine Menge von Teil-A-Spalten. Fehlende
|
||||
# Einzelwerte fuehren zu NA fuer die gesamte Summe, kein stilles Ignorieren.
|
||||
sekes_summe_raenge = function(daten, zeile, spalten) {
|
||||
raenge = sapply(spalten, function(spalte) {
|
||||
labels_attr = attr(daten[[spalte]], "labels")
|
||||
sekes_rang_aus_item(zeile[[spalte]], labels_attr)
|
||||
})
|
||||
if (any(is.na(raenge))) return(NA_real_)
|
||||
sum(raenge)
|
||||
}
|
||||
|
||||
sekes_wert_text = function(x) {
|
||||
if (length(x) == 0 || is.na(x)) "nicht auswertbar (fehlende Items)" else as.character(x)
|
||||
}
|
||||
|
||||
sekes_populationsvarianz = function(x) {
|
||||
x = x[!is.na(x)]
|
||||
n = length(x)
|
||||
if (n < 2) return(NA_real_)
|
||||
sum((x - mean(x))^2) / n
|
||||
}
|
||||
|
||||
sekes_ausfuelldatum = function(zeile) {
|
||||
kandidaten = c("created", "ended", "expired", "modified")
|
||||
for (spalte in kandidaten) {
|
||||
if (spalte %in% names(zeile) && !is.na(zeile[[spalte]][1])) {
|
||||
datum = suppressWarnings(as.Date(zeile[[spalte]][1]))
|
||||
if (!is.na(datum)) return(datum)
|
||||
}
|
||||
}
|
||||
NA
|
||||
}
|
||||
|
||||
# Feinere Zeitaufloesung (fuer die Sortierung mehrerer Treffer nach Aktualitaet),
|
||||
# dieselbe Kandidatenkette wie sekes_ausfuelldatum(), aber als Zeitstempel.
|
||||
sekes_zeitstempel_sortierwert = function(zeile) {
|
||||
kandidaten = c("created", "ended", "expired", "modified")
|
||||
for (spalte in kandidaten) {
|
||||
if (spalte %in% names(zeile) && !is.na(zeile[[spalte]][1])) {
|
||||
zeitpunkt = suppressWarnings(as.POSIXct(zeile[[spalte]][1]))
|
||||
if (!is.na(zeitpunkt)) return(as.numeric(zeitpunkt))
|
||||
}
|
||||
}
|
||||
NA_real_
|
||||
}
|
||||
|
||||
# Nie hartkodiert - immer aus dem labels-Attribut der Original-Spalte (haven).
|
||||
sekes_label_text = function(original_col, wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
|
||||
lbl_attr = attr(original_col, "labels")
|
||||
if (!is.null(lbl_attr) && length(lbl_attr) > 0) {
|
||||
pos = which(as.vector(lbl_attr) == as.numeric(wert[1]))
|
||||
if (length(pos) > 0) return(names(lbl_attr)[pos[1]])
|
||||
}
|
||||
NA_character_
|
||||
}
|
||||
|
||||
sekes_block_bearbeitet = function(zeile, block_cfg) {
|
||||
screen_spalte = paste0(block_cfg$spalte_praefix, "_screen")
|
||||
screen_wert = suppressWarnings(as.numeric(zeile[[screen_spalte]][1]))
|
||||
screen_ok = !is.na(screen_wert) && screen_wert != 0
|
||||
if (!isTRUE(block_cfg$benannt)) return(screen_ok)
|
||||
name_roh = zeile[[block_cfg$namensfeld]][1]
|
||||
name_txt = if (is.null(name_roh) || is.na(name_roh)) "" else trimws(as.character(name_roh))
|
||||
nchar(name_txt) > 0 && screen_ok
|
||||
}
|
||||
|
||||
sekes_block_name = function(zeile, block_cfg) {
|
||||
if (isTRUE(block_cfg$benannt)) {
|
||||
name_roh = zeile[[block_cfg$namensfeld]][1]
|
||||
name_txt = if (is.null(name_roh) || is.na(name_roh)) "" else trimws(as.character(name_roh))
|
||||
if (nchar(name_txt) > 0) return(name_txt)
|
||||
}
|
||||
block_cfg$label_default
|
||||
}
|
||||
|
||||
sekes_block_screening_wert = function(zeile, block_cfg) {
|
||||
screen_spalte = paste0(block_cfg$spalte_praefix, "_screen")
|
||||
suppressWarnings(as.numeric(zeile[[screen_spalte]][1]))
|
||||
}
|
||||
|
||||
sekes_block_items_stufen = function(daten, zeile, block_cfg) {
|
||||
sapply(seq_len(12), function(i) {
|
||||
spalte = paste0(block_cfg$spalte_praefix, "_", sprintf("%02d", i))
|
||||
labels_attr = attr(daten[[spalte]], "labels")
|
||||
sekes_stufe_aus_item(zeile[[spalte]], labels_attr)
|
||||
})
|
||||
}
|
||||
|
||||
# Entfernt formr-Markdown-Reste aus Itemlabels (z.B. escapte Punkte "1\.") und
|
||||
# fuehrende Nummerierungen wie "1\. " oder "1. " - die Itemnummer zeigt item-nr
|
||||
# ohnehin schon separat an, eine doppelte Nummer waere redundant.
|
||||
bereinige_markdown = function(x) {
|
||||
if (is.null(x) || length(x) == 0 || is.na(x[1])) return(NA_character_)
|
||||
x = as.character(x[1])
|
||||
x = gsub("\\*\\*", "", x)
|
||||
x = gsub("(?<!\\\\)\\*", "", x, perl = TRUE)
|
||||
x = gsub("\\\\\\.", ".", x)
|
||||
trimws(x)
|
||||
}
|
||||
|
||||
sekes_parse_item_label = function(lbl_roh) {
|
||||
if (is.null(lbl_roh) || length(lbl_roh) == 0 || is.na(lbl_roh[1]) ||
|
||||
nchar(trimws(as.character(lbl_roh[1]))) == 0) {
|
||||
return(NA_character_)
|
||||
}
|
||||
roh = sub("^\\s*\\d+\\\\?\\.\\s*", "", as.character(lbl_roh[1]))
|
||||
bereinige_markdown(roh)
|
||||
}
|
||||
|
||||
sekes_block_items_text = function(daten, block_cfg) {
|
||||
sapply(seq_len(12), function(i) {
|
||||
spalte = paste0(block_cfg$spalte_praefix, "_", sprintf("%02d", i))
|
||||
lbl = sekes_parse_item_label(attr(daten[[spalte]], "label"))
|
||||
if (is.na(lbl) || nchar(lbl) == 0) paste0("Item ", i) else lbl
|
||||
})
|
||||
}
|
||||
|
||||
# Skala 2.x - Durchschnittskompetenz pro affektiver Reaktion (Abschnitt 6.1).
|
||||
sekes_skala_2x = function(items_stufen, positiv) {
|
||||
if (any(is.na(items_stufen))) return(NA_real_)
|
||||
if (isTRUE(positiv)) return(sum(items_stufen) / 12)
|
||||
(sqrt(items_stufen[1] * items_stufen[2]) + sum(items_stufen[3:12])) / 11
|
||||
}
|
||||
|
||||
# Rohe Beitraege eines B1-B7-Blocks zu den zehn Skala-3.x-Kompetenzen (Abschnitt 6.2).
|
||||
# Position 8 fliesst bewusst in keine dieser Formeln ein.
|
||||
sekes_skala_3x_komponenten = function(items_stufen) {
|
||||
c(
|
||||
"3.1" = sqrt(items_stufen[1] * items_stufen[2]),
|
||||
"3.2" = items_stufen[3],
|
||||
"3.3" = items_stufen[4],
|
||||
"3.4" = (items_stufen[5] + items_stufen[7]) / 2,
|
||||
"3.5" = items_stufen[6],
|
||||
"3.6a" = (items_stufen[5] + items_stufen[6] + items_stufen[7]) / 3,
|
||||
"3.6b" = items_stufen[9],
|
||||
"3.7" = items_stufen[10],
|
||||
"3.8" = items_stufen[11],
|
||||
"3.9" = items_stufen[12],
|
||||
"3.10" = (items_stufen[11] + items_stufen[12]) / 2
|
||||
)
|
||||
}
|
||||
|
||||
sekes_tabelle_ui = function(kopfzeile, zeilen_ui) {
|
||||
tags$table(class = "sekes-tabelle",
|
||||
tags$thead(tags$tr(lapply(kopfzeile, function(h) tags$th(h)))),
|
||||
tags$tbody(zeilen_ui)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
# (Die eigentliche Aufbereitung erfolgt je Chiffre-Abfrage im eventReactive-Block
|
||||
# im Server-Abschnitt, da 'daten_sekes' erst zur Laufzeit per Klick geladen wird.)
|
||||
|
||||
|
||||
# UI ####
|
||||
|
||||
app_css = "
|
||||
body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; }
|
||||
.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; white-space: pre-wrap;
|
||||
}
|
||||
.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;
|
||||
}
|
||||
.alert-hinweis {
|
||||
background: #ECEFF1; border-left: 5px solid #607D8B;
|
||||
padding: 10px 16px; border-radius: 4px; color: #37474F;
|
||||
margin-bottom: 12px; font-size: 0.9em;
|
||||
}
|
||||
.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;
|
||||
}
|
||||
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
|
||||
.meta-block strong { color: #222; }
|
||||
.kontext-zeile {
|
||||
display: flex; gap: 8px; align-items: baseline;
|
||||
padding: 4px 0; color: #444; font-size: 0.93em;
|
||||
}
|
||||
.kontext-label { font-weight: 600; color: #333; min-width: 220px; }
|
||||
.sekes-tabelle { width: 100%; border-collapse: collapse; font-size: 0.92em; margin-bottom: 8px; }
|
||||
.sekes-tabelle th {
|
||||
text-align: left; color: #8B2635; border-bottom: 2px solid #8B2635;
|
||||
padding: 6px 10px; font-weight: 700;
|
||||
}
|
||||
.sekes-tabelle td { padding: 6px 10px; border-bottom: 1px solid #F0F0F0; color: #333; }
|
||||
.sekes-tabelle tr.nicht-bearbeitet td { color: #999; font-style: italic; }
|
||||
.divisor-hinweis { font-size: 0.85em; color: #777; margin-bottom: 10px; font-style: italic; }
|
||||
.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: 26px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.stufe-badge {
|
||||
border-radius: 4px; padding: 2px 9px; font-weight: 700;
|
||||
font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
|
||||
}
|
||||
.stufe-badge-0 { background: #4CAF50; color: white; }
|
||||
.stufe-badge-1 { background: #AED581; color: #333333; }
|
||||
.stufe-badge-2 { background: #FFB74D; color: #333333; }
|
||||
.stufe-badge-3 { background: #EF5350; color: white; }
|
||||
.stufe-badge-4 { background: #B71C1C; color: white; }
|
||||
.hinweis-klein { font-size: 0.8em; color: #999; font-style: italic; margin-top: 10px; }
|
||||
.details-block summary { cursor: pointer; color: #8B2635; font-weight: 600; margin-bottom: 10px; }
|
||||
"
|
||||
|
||||
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("SEK-ES – Skalen zur Erfassung der Emotionsregulation bei Stress"),
|
||||
tags$p("Ebert, Christ & Berking (2013/2014) | Einzelfall-Auswertung")
|
||||
),
|
||||
|
||||
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_ui"),
|
||||
uiOutput("ergebnis_ui")
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
# Word-Export ####
|
||||
|
||||
erstelle_sekes_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_klein = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("SEK-ES - Einzelauswertung", fp_titel)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label),
|
||||
ftext(erg$chiffre, fp_normal),
|
||||
ftext(" Ausfuelldatum: ", fp_label),
|
||||
ftext(erg$ausfuelldatum_str, fp_normal)
|
||||
))
|
||||
if (!is.null(erg$info_mehrere)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(erg$info_mehrere, fp_text(font.size = 10, italic = TRUE, color = "#555555"))
|
||||
))
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Alter: ", fp_label), ftext(erg$demografie$alter_text, fp_normal),
|
||||
ftext(" Geschlecht: ", fp_label), ftext(erg$demografie$geschlecht_text, fp_normal),
|
||||
ftext(" Beruf: ", fp_label), ftext(erg$demografie$beruf_text, fp_normal)
|
||||
))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Screening (Intensitaet 0-10)", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Vergleichswerte: deskriptive Kennwerte der Validierungsstichprobe, keine Normwerte (Tabelle 2).",
|
||||
fp_klein
|
||||
)))
|
||||
for (b in erg$bloecke) {
|
||||
ref = SEKES_REFERENZ_SCREENING[[b$key]]
|
||||
if (isTRUE(b$bearbeitet)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(b$name, ": "), fp_label),
|
||||
ftext(paste0(
|
||||
b$screening_wert, " / 10 (KG: ", sprintf("%.2f", ref$kg_m), " [SD ", sprintf("%.2f", ref$kg_sd),
|
||||
"], EG: ", sprintf("%.2f", ref$eg_m), " [SD ", sprintf("%.2f", ref$eg_sd), "])"
|
||||
), fp_normal)
|
||||
))
|
||||
} else {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(b$name, ": "), fp_label),
|
||||
ftext("nicht bearbeitet", fp_text(font.size = 11, italic = TRUE, color = "#999999"))
|
||||
))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Skala 2.x – Durchschnittskompetenz pro affektiver Reaktion", fp_abschnitt)))
|
||||
bloecke_bearbeitet = Filter(function(b) isTRUE(b$bearbeitet), erg$bloecke)
|
||||
for (b in bloecke_bearbeitet) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(b$name, ": "), fp_label),
|
||||
ftext(sprintf("%.2f", b$skala2x), fp_normal)
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
if (!is.null(erg$skala3x)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Skala 3.x – Spezifische Kompetenzen", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0(
|
||||
"Berechnet ueber ", erg$n_bearbeitet_b1_b7, " von 7 moeglichen Bloecken (B1-B7)."
|
||||
), fp_klein)))
|
||||
for (sk in names(SEKES_SKALA_3X_NAMEN)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(sk, " ", SEKES_SKALA_3X_NAMEN[[sk]], ": "), fp_label),
|
||||
ftext(sprintf("%.2f", erg$skala3x[[sk]]), fp_normal)
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
if (!is.null(erg$skala4x)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Skala 4.x – Generalisiertheit", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(SEKES_SKALA4X_HINWEIS, fp_klein)))
|
||||
for (sk in names(SEKES_SKALA_3X_NAMEN)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(sk, " ", SEKES_SKALA_3X_NAMEN[[sk]], ": "), fp_label),
|
||||
ftext(sprintf("%.3f", erg$skala4x[[sk]]), fp_normal)
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Teil A – PANAS", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("PANAS-Positiv: ", fp_label), ftext(sekes_wert_text(erg$teil_a$panas_positiv), fp_normal)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("PANAS-Negativ: ", fp_label), ftext(sekes_wert_text(erg$teil_a$panas_negativ), fp_normal)
|
||||
))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Teil A – weitere Zusatzskalen", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(SEKES_ZUSATZSKALEN_HINWEIS, fp_klein)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Bewältigungs-Emotionen: ", fp_label), ftext(sekes_wert_text(erg$teil_a$bewaeltigung), fp_normal)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("EMO-Check Positiv: ", fp_label), ftext(sekes_wert_text(erg$teil_a$emocheck_positiv), fp_normal)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("EMO-Check Negativ: ", fp_label), ftext(sekes_wert_text(erg$teil_a$emocheck_negativ), fp_normal)
|
||||
))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(SEKES_ROHWERT_HINWEIS, fp_klein)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
doc = body_add_fpar(doc, fpar(ftext(SEKES_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)))
|
||||
}
|
||||
})
|
||||
|
||||
# Skripte werden NICHT beim App-Start gesourct, nur beim Klick auf "Auswerten".
|
||||
ergebnis_r = eventReactive(input$btn_suchen, {
|
||||
|
||||
chiffre = toupper(trimws(input$chiffre))
|
||||
|
||||
if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0)) {
|
||||
return(list(typ = "format_fehler",
|
||||
meldung = "Bitte eine Patientenchiffre eingeben."))
|
||||
}
|
||||
if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
|
||||
return(list(typ = "format_fehler", meldung = paste0(
|
||||
"Ungueltiges Chiffre-Format. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123)."
|
||||
)))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(typ = "skript_fehler", meldung = paste0(
|
||||
"Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT
|
||||
)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(typ = "skript_fehler", meldung = paste0(
|
||||
"Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT
|
||||
)))
|
||||
}
|
||||
|
||||
ok_download = tryCatch({
|
||||
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok_download$ok) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Fehler im Download-Skript: ", ok_download$msg)))
|
||||
}
|
||||
|
||||
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
|
||||
})
|
||||
|
||||
alter_wd = getwd()
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
wd_ziel = if (!is.null(db_ordner)) db_ordner else
|
||||
dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
setwd(wd_ziel)
|
||||
|
||||
ok_pseudonym = 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_pseudonym$ok) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Fehler im Pseudonym-Skript: ", ok_pseudonym$msg)))
|
||||
}
|
||||
|
||||
if (!exists("daten_sekes", envir = .GlobalEnv)) {
|
||||
return(list(typ = "skript_fehler", meldung = paste0(
|
||||
"Objekt 'daten_sekes' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen."
|
||||
)))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||||
return(list(typ = "skript_fehler", meldung = paste0(
|
||||
"Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen."
|
||||
)))
|
||||
}
|
||||
|
||||
daten = get("daten_sekes", envir = .GlobalEnv)
|
||||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
# Kein Filter auf 'instrument' noetig - diese App erhaelt ausschliesslich Daten
|
||||
# des SEK-ES-Runs, ein reiner Chiffre-Lookup reicht.
|
||||
treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
|
||||
if (nrow(treffer_ps) == 0) {
|
||||
return(list(typ = "chiffre_nicht_gefunden", meldung = paste0(
|
||||
"Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden."
|
||||
)))
|
||||
}
|
||||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||||
|
||||
treffer_dat = daten[daten$session %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(typ = "sitzung_nicht_gefunden", meldung = paste0(
|
||||
"Chiffre '", chiffre, "' wurde gefunden, aber kein SEK-ES-Datensatz zu den ",
|
||||
"zugehoerigen Sitzungs-IDs (", length(alle_session_ids), " geprueft)."
|
||||
)))
|
||||
}
|
||||
|
||||
info_mehrere = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
zeitstempel = sapply(seq_len(nrow(treffer_dat)), function(i) {
|
||||
sekes_zeitstempel_sortierwert(treffer_dat[i, , drop = FALSE])
|
||||
})
|
||||
treffer_dat = treffer_dat[order(zeitstempel, decreasing = TRUE), ]
|
||||
info_mehrere = paste0(
|
||||
"Mehrere Ausfuellungen fuer diese Chiffre gefunden (", n, " Eintraege). ",
|
||||
"Es wird die Ausfuellung mit dem neuesten Zeitstempel angezeigt."
|
||||
)
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
|
||||
ausfuelldatum = sekes_ausfuelldatum(zeile)
|
||||
ausfuelldatum_str = if (is.na(ausfuelldatum)) "Ausfülldatum nicht ermittelbar" else
|
||||
format(ausfuelldatum, "%d.%m.%Y")
|
||||
ausfuelldatum_dateiname = if (is.na(ausfuelldatum)) "unbekannt" else
|
||||
format(ausfuelldatum, "%Y%m%d")
|
||||
|
||||
alter_num = suppressWarnings(as.numeric(zeile[["sekes_alter"]][1]))
|
||||
alter_text = if (is.na(alter_num)) "k. A." else as.character(alter_num)
|
||||
|
||||
geschlecht_text_roh = sekes_label_text(daten[["sekes_geschlecht"]], zeile[["sekes_geschlecht"]])
|
||||
geschlecht_text = if (is.na(geschlecht_text_roh)) "k. A." else geschlecht_text_roh
|
||||
|
||||
beruf_roh = zeile[["sekes_beruf"]][1]
|
||||
beruf_text = if (is.null(beruf_roh) || is.na(beruf_roh) || nchar(trimws(as.character(beruf_roh))) == 0)
|
||||
"k. A." else trimws(as.character(beruf_roh))
|
||||
|
||||
bloecke = lapply(SEKES_BLOECKE, function(block_cfg) {
|
||||
bearbeitet = sekes_block_bearbeitet(zeile, block_cfg)
|
||||
name = sekes_block_name(zeile, block_cfg)
|
||||
|
||||
if (!bearbeitet) {
|
||||
return(list(
|
||||
key = block_cfg$key, name = name, bearbeitet = FALSE,
|
||||
screening_wert = NA_real_, skala2x = NA_real_,
|
||||
items_stufen = rep(NA_real_, 12), items_text = sekes_block_items_text(daten, block_cfg),
|
||||
positiv = block_cfg$positiv
|
||||
))
|
||||
}
|
||||
|
||||
items_stufen = sekes_block_items_stufen(daten, zeile, block_cfg)
|
||||
items_text = sekes_block_items_text(daten, block_cfg)
|
||||
screening = sekes_block_screening_wert(zeile, block_cfg)
|
||||
skala2x = sekes_skala_2x(items_stufen, block_cfg$positiv)
|
||||
|
||||
komponenten = if (!isTRUE(block_cfg$positiv)) sekes_skala_3x_komponenten(items_stufen) else NULL
|
||||
|
||||
list(
|
||||
key = block_cfg$key, name = name, bearbeitet = TRUE,
|
||||
screening_wert = screening, skala2x = skala2x,
|
||||
items_stufen = items_stufen, items_text = items_text,
|
||||
positiv = block_cfg$positiv, komponenten = komponenten
|
||||
)
|
||||
})
|
||||
|
||||
bloecke_b1_b7 = Filter(function(b) b$key != "b8" && isTRUE(b$bearbeitet), bloecke)
|
||||
n_bearbeitet_b1_b7 = length(bloecke_b1_b7)
|
||||
|
||||
skala3x = NULL
|
||||
skala4x = NULL
|
||||
if (n_bearbeitet_b1_b7 >= 1) {
|
||||
komp_matrix = do.call(rbind, lapply(bloecke_b1_b7, function(b) b$komponenten))
|
||||
skala3x = as.list(colSums(komp_matrix) / n_bearbeitet_b1_b7)
|
||||
}
|
||||
if (n_bearbeitet_b1_b7 >= 2) {
|
||||
komp_matrix = do.call(rbind, lapply(bloecke_b1_b7, function(b) b$komponenten))
|
||||
skala4x = as.list(apply(komp_matrix, 2, sekes_populationsvarianz))
|
||||
}
|
||||
|
||||
teil_a = list(
|
||||
panas_positiv = sekes_summe_raenge(daten, zeile, SEKES_PANAS_POSITIV_ITEMS),
|
||||
panas_negativ = sekes_summe_raenge(daten, zeile, SEKES_PANAS_NEGATIV_ITEMS),
|
||||
bewaeltigung = sekes_summe_raenge(daten, zeile, SEKES_BEWAELTIGUNG_ITEMS),
|
||||
emocheck_positiv = sekes_summe_raenge(daten, zeile, SEKES_EMOCHECK_POSITIV_ITEMS),
|
||||
emocheck_negativ = sekes_summe_raenge(daten, zeile, SEKES_EMOCHECK_NEGATIV_ITEMS)
|
||||
)
|
||||
|
||||
list(
|
||||
typ = "ok",
|
||||
chiffre = chiffre,
|
||||
ausfuelldatum_str = ausfuelldatum_str,
|
||||
ausfuelldatum_dateiname = ausfuelldatum_dateiname,
|
||||
info_mehrere = info_mehrere,
|
||||
demografie = list(alter_text = alter_text, geschlecht_text = geschlecht_text, beruf_text = beruf_text),
|
||||
bloecke = bloecke,
|
||||
n_bearbeitet_b1_b7 = n_bearbeitet_b1_b7,
|
||||
skala3x = skala3x,
|
||||
skala4x = skala4x,
|
||||
teil_a = teil_a
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (d$typ %in% c("format_fehler", "skript_fehler", "chiffre_nicht_gefunden", "sitzung_nicht_gefunden")) {
|
||||
div(class = "alert-fehler", d$meldung)
|
||||
}
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (d$typ != "ok" || is.null(d$info_mehrere)) return(NULL)
|
||||
div(class = "alert-warnung", d$info_mehrere)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (d$typ != "ok") return(NULL)
|
||||
|
||||
stufe_badge = function(stufe) {
|
||||
sk = if (!is.na(stufe) && stufe >= 0 && stufe <= 4) as.character(as.integer(stufe)) else "0"
|
||||
span(class = paste0("stufe-badge stufe-badge-", sk), stufe)
|
||||
}
|
||||
|
||||
# Screening: alle acht Bloecke, nicht bearbeitete klar als solche markiert.
|
||||
screening_zeilen = lapply(d$bloecke, function(b) {
|
||||
ref = SEKES_REFERENZ_SCREENING[[b$key]]
|
||||
if (isTRUE(b$bearbeitet)) {
|
||||
tags$tr(
|
||||
tags$td(b$name), tags$td(paste0(b$screening_wert, " / 10")),
|
||||
tags$td(sprintf("%.2f (SD %.2f)", ref$kg_m, ref$kg_sd)),
|
||||
tags$td(sprintf("%.2f (SD %.2f)", ref$eg_m, ref$eg_sd))
|
||||
)
|
||||
} else {
|
||||
tags$tr(class = "nicht-bearbeitet",
|
||||
tags$td(b$name), tags$td("nicht bearbeitet"), tags$td("–"), tags$td("–")
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
skala2x_zeilen = lapply(Filter(function(b) isTRUE(b$bearbeitet), d$bloecke), function(b) {
|
||||
tags$tr(tags$td(b$name), tags$td(sprintf("%.2f", b$skala2x)))
|
||||
})
|
||||
|
||||
skala3x_ui = if (!is.null(d$skala3x)) tagList(
|
||||
tags$hr(),
|
||||
tags$h5("Skala 3.x – Spezifische Kompetenzen"),
|
||||
div(class = "divisor-hinweis",
|
||||
paste0("Berechnet über ", d$n_bearbeitet_b1_b7, " von 7 möglichen Blöcken (B1–B7).")),
|
||||
sekes_tabelle_ui(c("Skala", "Kompetenz", "Wert"),
|
||||
lapply(names(SEKES_SKALA_3X_NAMEN), function(sk) {
|
||||
tags$tr(tags$td(sk), tags$td(SEKES_SKALA_3X_NAMEN[[sk]]), tags$td(sprintf("%.2f", d$skala3x[[sk]])))
|
||||
})
|
||||
)
|
||||
) else NULL
|
||||
|
||||
skala4x_ui = if (!is.null(d$skala4x)) tagList(
|
||||
tags$hr(),
|
||||
tags$h5("Skala 4.x – Generalisiertheit"),
|
||||
div(class = "divisor-hinweis", SEKES_SKALA4X_HINWEIS),
|
||||
sekes_tabelle_ui(c("Skala", "Kompetenz", "Populationsvarianz"),
|
||||
lapply(names(SEKES_SKALA_3X_NAMEN), function(sk) {
|
||||
tags$tr(tags$td(sk), tags$td(SEKES_SKALA_3X_NAMEN[[sk]]), tags$td(sprintf("%.3f", d$skala4x[[sk]])))
|
||||
})
|
||||
)
|
||||
) else NULL
|
||||
|
||||
panas_ui = tagList(
|
||||
tags$hr(),
|
||||
tags$h5("Teil A – PANAS"),
|
||||
sekes_tabelle_ui(c("Skala", "Summenwert (10–50)"), list(
|
||||
tags$tr(tags$td("PANAS-Positiv"), tags$td(sekes_wert_text(d$teil_a$panas_positiv))),
|
||||
tags$tr(tags$td("PANAS-Negativ"), tags$td(sekes_wert_text(d$teil_a$panas_negativ)))
|
||||
))
|
||||
)
|
||||
|
||||
zusatzskalen_ui = tags$details(class = "details-block",
|
||||
tags$summary("Teil A – weitere Zusatzskalen (unverifiziert)"),
|
||||
div(class = "alert-warnung", SEKES_ZUSATZSKALEN_HINWEIS),
|
||||
sekes_tabelle_ui(c("Skala", "Summenwert"), list(
|
||||
tags$tr(tags$td("Bewältigungs-Emotionen"), tags$td(sekes_wert_text(d$teil_a$bewaeltigung))),
|
||||
tags$tr(tags$td("EMO-Check Positiv"), tags$td(sekes_wert_text(d$teil_a$emocheck_positiv))),
|
||||
tags$tr(tags$td("EMO-Check Negativ"), tags$td(sekes_wert_text(d$teil_a$emocheck_negativ)))
|
||||
))
|
||||
)
|
||||
|
||||
itemrohdaten_ui = tags$details(class = "details-block",
|
||||
tags$summary("Itemrohdaten (Qualitätskontrolle, keine Interpretationsgrundlage)"),
|
||||
lapply(Filter(function(b) isTRUE(b$bearbeitet), d$bloecke), function(b) {
|
||||
tagList(
|
||||
tags$h5(b$name),
|
||||
div(lapply(seq_len(12), function(i) {
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(i, ".")),
|
||||
div(class = "item-text", b$items_text[i]),
|
||||
stufe_badge(b$items_stufen[i])
|
||||
)
|
||||
}))
|
||||
)
|
||||
})
|
||||
)
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "SEK-ES"),
|
||||
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), d$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfülldatum: "), d$ausfuelldatum_str
|
||||
),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Alter:"), div(d$demografie$alter_text)),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Geschlecht:"), div(d$demografie$geschlecht_text)),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Beruf:"), div(d$demografie$beruf_text)),
|
||||
|
||||
tags$hr(),
|
||||
tags$h5("Screening (Intensität 0–10)"),
|
||||
div(class = "alert-hinweis",
|
||||
"Vergleichswerte (KG/EG): deskriptive Kennwerte der Validierungsstichprobe, keine Normwerte."),
|
||||
sekes_tabelle_ui(c("Emotion/Block", "Screeningwert", "KG M (SD)", "EG M (SD)"), screening_zeilen),
|
||||
|
||||
tags$hr(),
|
||||
tags$h5("Skala 2.x – Durchschnittskompetenz pro affektiver Reaktion"),
|
||||
sekes_tabelle_ui(c("Emotion/Block", "Skala 2.x"), skala2x_zeilen),
|
||||
|
||||
skala3x_ui,
|
||||
skala4x_ui,
|
||||
|
||||
panas_ui,
|
||||
zusatzskalen_ui,
|
||||
|
||||
tags$hr(),
|
||||
itemrohdaten_ui,
|
||||
|
||||
div(class = "hinweis-klein", SEKES_ROHWERT_HINWEIS)
|
||||
)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.list(d) && identical(d$typ, "ok")) {
|
||||
paste0("SEKES_", d$chiffre, "_", d$ausfuelldatum_dateiname, ".docx")
|
||||
} else {
|
||||
"SEKES_export.docx"
|
||||
}
|
||||
},
|
||||
content = function(file) {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (!is.list(d) || !identical(d$typ, "ok")) {
|
||||
doc = read_docx()
|
||||
meldung = if (is.list(d) && !is.null(d$meldung)) d$meldung else
|
||||
"Kein Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Auswerten' klicken."
|
||||
doc = body_add_par(doc, meldung, style = "Normal")
|
||||
print(doc, target = file)
|
||||
return()
|
||||
}
|
||||
doc = tryCatch(
|
||||
erstelle_sekes_docx(d),
|
||||
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)
|
||||
Loading…
Add table
Add a link
Reference in a new issue