Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
731
Fragebogen zum Schlafverhalten/app.R
Normal file
731
Fragebogen zum Schlafverhalten/app.R
Normal file
|
|
@ -0,0 +1,731 @@
|
|||
# Praeambel ####
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_schlafverhalten.R"
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
# Name der Zeitstempel-Spalte fuer den Ausfuellzeitpunkt in daten_schlafverhalten.
|
||||
# TODO: beim ersten Testlauf gegen die echten formr-Daten mit
|
||||
# str(daten_schlafverhalten) pruefen und ggf. anpassen (z.B. 'created' oder 'ended').
|
||||
SPALTE_AUSFUELLDATUM = "created"
|
||||
|
||||
SCHLAF_DISCLAIMER = paste0(
|
||||
"Diese Uebersicht ist eine rein deskriptive Aufbereitung der Einzelantworten ohne Score, ",
|
||||
"Cutoff oder Klassifikation und ersetzt keine klinische Einschaetzung. Die Interpretation ",
|
||||
"obliegt der behandelnden Person."
|
||||
)
|
||||
|
||||
HERVORHEBUNG_FARBE = "#FFE0B2"
|
||||
|
||||
# Metadaten je Item: fallback (Fragetext, falls kein label-Attribut vorhanden),
|
||||
# typ ("mc3" = 3-stufige Skala, "dichotom" = ja/nein, "zeit" = HH:MM-String,
|
||||
# "zahl" = ganzzahlige Stringangabe, "dezimal" = Dezimalstring, "text" = MM.JJJJ-String),
|
||||
# regel (Hervorhebungsregel "A", "B" oder NA = keine Hervorhebung).
|
||||
ITEM_META = list(
|
||||
schlaf_01 = list(fallback = "Einschlafstoerungen (seit mindestens 4 Wochen)", typ = "mc3", regel = "A"),
|
||||
schlaf_02 = list(fallback = "Durchschlafstoerungen (seit mindestens 4 Wochen)", typ = "mc3", regel = "A"),
|
||||
schlaf_03 = list(fallback = "Fruehzeitiges Erwachen (seit mindestens 4 Wochen)", typ = "mc3", regel = "A"),
|
||||
schlaf_04 = list(fallback = "Schlaf nicht erholsam (seit mindestens 4 Wochen)", typ = "mc3", regel = "A"),
|
||||
schlaf_05 = list(fallback = "Auswirkungen auf den Tag (seit mindestens 4 Wochen)", typ = "mc3", regel = "A"),
|
||||
schlaf_06 = list(fallback = "Tagsueber wach halten", typ = "mc3", regel = "A"),
|
||||
schlaf_07 = list(fallback = "Schichtarbeit", typ = "dichotom", regel = NA),
|
||||
schlaf_08 = list(fallback = "Restless-Legs-artige Symptome", typ = "mc3", regel = "A"),
|
||||
schlaf_09 = list(fallback = "Schnarchen/Atempausen", typ = "mc3", regel = "A"),
|
||||
schlaf_10 = list(fallback = "Naechtliches Hochschrecken/Schlafwandeln", typ = "dichotom", regel = NA),
|
||||
schlaf_11 = list(fallback = "Kataplexie-artige Symptome", typ = "mc3", regel = "A"),
|
||||
schlaf_12_01 = list(fallback = "Koffein am Abend", typ = "dichotom", regel = NA),
|
||||
schlaf_12_02 = list(fallback = "Nikotin am Abend", typ = "dichotom", regel = NA),
|
||||
schlaf_12_03 = list(fallback = "Alkohol am Abend", typ = "dichotom", regel = NA),
|
||||
schlaf_12_04 = list(fallback = "Appetitzuegler", typ = "dichotom", regel = NA),
|
||||
schlaf_12_05 = list(fallback = "Hunger/Uebersaettigung beim Zubettgehen", typ = "dichotom", regel = NA),
|
||||
schlaf_12_06 = list(fallback = "Sport tagsueber normalerweise", typ = "dichotom", regel = NA),
|
||||
schlaf_12_07 = list(fallback = "Sport tagsueber in den letzten Wochen", typ = "dichotom", regel = NA),
|
||||
schlaf_12_08 = list(fallback = "Sport am Abend", typ = "dichotom", regel = NA),
|
||||
schlaf_12_09 = list(fallback = "Stoerungen im Schlafzimmer", typ = "dichotom", regel = NA),
|
||||
schlaf_12_10 = list(fallback = "Anstrengende Taetigkeit vor dem Zubettgehen", typ = "dichotom", regel = NA),
|
||||
schlaf_12_11 = list(fallback = "Nachts auf die Uhr sehen", typ = "dichotom", regel = NA),
|
||||
schlaf_12_12 = list(fallback = "Lesen/Essen/Fernsehen im Bett", typ = "dichotom", regel = NA),
|
||||
schlaf_12_13 = list(fallback = "Gruebeln im Bett", typ = "dichotom", regel = NA),
|
||||
schlaf_13 = list(fallback = "Angst vorm Zubettgehen", typ = "dichotom", regel = "B"),
|
||||
schlaf_14 = list(fallback = "Anstrengung, schlafen zu muessen", typ = "dichotom", regel = "B"),
|
||||
schlaf_15 = list(fallback = "Furcht vor den Folgen des schlechten Schlafs", typ = "dichotom", regel = "B"),
|
||||
schlaf_16 = list(fallback = "Aerger/Wut/Angst wegen der Schlafschwierigkeiten", typ = "dichotom", regel = "B"),
|
||||
schlaf_17 = list(fallback = "Einschraenkung sozialer Aktivitaeten wegen des Schlafs", typ = "dichotom", regel = "B"),
|
||||
schlaf_18 = list(fallback = "Besserer Schlaf im Urlaub/auswaerts", typ = "dichotom", regel = "B"),
|
||||
schlaf_19 = list(fallback = "Beginn der Schlafschwierigkeiten in einer Stress-Situation", typ = "dichotom", regel = "B"),
|
||||
schlaf_20 = list(fallback = "Schlafmittel jemals eingenommen", typ = "mc3", regel = NA),
|
||||
schlaf_20_von = list(fallback = "Einnahme von Schlafmitteln - von (MM.JJJJ)", typ = "text", regel = NA),
|
||||
schlaf_20_bis = list(fallback = "Einnahme von Schlafmitteln - bis (MM.JJJJ)", typ = "text", regel = NA),
|
||||
schlaf_21 = list(fallback = "Alkohol zur Schlafbewaeltigung", typ = "mc3", regel = "A"),
|
||||
schlaf_22 = list(fallback = "Bettgehzeit", typ = "text", regel = NA),
|
||||
schlaf_23 = list(fallback = "Einschlafzeit", typ = "text", regel = NA),
|
||||
schlaf_24 = list(fallback = "Anzahl naechtliches Aufwachen", typ = "text", regel = NA),
|
||||
schlaf_25 = list(fallback = "Minuten bis erneutes Einschlafen", typ = "text", regel = NA),
|
||||
schlaf_26 = list(fallback = "Aufwachzeit morgens", typ = "text", regel = NA),
|
||||
schlaf_27 = list(fallback = "Zeitpunkt, an dem das Bett verlassen wird", typ = "text", regel = NA),
|
||||
schlaf_28 = list(fallback = "Subjektiv benoetigte Schlafstunden", typ = "text", regel = NA)
|
||||
)
|
||||
|
||||
# Rein deskriptive Convenience-Einteilung fuer die Anzeige, keine autorisierte
|
||||
# Subskala und im Original nicht so benannt.
|
||||
ABSCHNITTE = list(
|
||||
list(titel = "Ein-/Durchschlafstoerungen, Erholsamkeit, Tagesbeeintraechtigung",
|
||||
vars = c("schlaf_01", "schlaf_02", "schlaf_03", "schlaf_04", "schlaf_05")),
|
||||
list(titel = "Tagesmuedigkeit, Schichtarbeit",
|
||||
vars = c("schlaf_06", "schlaf_07")),
|
||||
list(titel = "Restless-Legs-artige Symptome, Schnarchen/Atempausen",
|
||||
vars = c("schlaf_08", "schlaf_09")),
|
||||
list(titel = "Parasomnie-artige Symptome, Kataplexie-artige Symptome",
|
||||
vars = c("schlaf_10", "schlaf_11")),
|
||||
list(titel = "Schlafhygiene-Verhaltensweisen",
|
||||
vars = paste0("schlaf_12_", sprintf("%02d", 1:13))),
|
||||
list(titel = "Schlafbezogene Aengste/Kognitionen",
|
||||
vars = paste0("schlaf_", 13:19)),
|
||||
list(titel = "Schlafmittelgebrauch",
|
||||
vars = c("schlaf_20", "schlaf_20_von", "schlaf_20_bis")),
|
||||
list(titel = "Alkohol zur Schlafbewaeltigung",
|
||||
vars = c("schlaf_21")),
|
||||
list(titel = "Konkrete Schlaf-Wach-Zeiten",
|
||||
vars = c("schlaf_22", "schlaf_23", "schlaf_24", "schlaf_25", "schlaf_26", "schlaf_27", "schlaf_28"))
|
||||
)
|
||||
|
||||
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)
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# Entfernt Markdown-Reste (Fett-Sternchen, rueckwaerts-escapte Satzzeichen wie
|
||||
# "22\." aus formr-Nummerierungen) und umgebende Leerzeichen aus Fragetexten,
|
||||
# die aus dem label-Attribut der formr-Spalten stammen.
|
||||
bereinige_text = function(x) {
|
||||
if (is.null(x) || length(x) == 0 || is.na(x[1])) return(NA_character_)
|
||||
x = trimws(as.character(x[1]))
|
||||
x = gsub("\\*\\*", "", x)
|
||||
x = gsub("\\\\([[:punct:]])", "\\1", x)
|
||||
trimws(x)
|
||||
}
|
||||
|
||||
schlaf_item_text = function(original_col, fallback) {
|
||||
txt = bereinige_text(attr(original_col, "label"))
|
||||
if (is.na(txt) || nchar(txt) == 0) return(fallback)
|
||||
# Formr-Labels enthalten haeufig bereits die Itemnummer als Praefix
|
||||
# (z.B. "13. Haben Sie..."), die aber schon separat als .item-nr angezeigt
|
||||
# wird - Praefix entfernen, um Dopplungen wie "13. 13. Haben Sie..." zu vermeiden.
|
||||
txt = sub("^[0-9]+(\\.[0-9]+)*\\.?\\s*", "", txt)
|
||||
if (nchar(txt) == 0) fallback else txt
|
||||
}
|
||||
|
||||
# Loest den Rohwert ueber das labels-Attribut der ORIGINAL-Spalte zum
|
||||
# Antworttext auf (fuer Anzeige), nie hartkodiert. Notwendig, weil die
|
||||
# Choice-Reihenfolge je nach Item-Setup abweichen kann (z.B. sind die
|
||||
# mc_button-Items ja=1/nein=2 kodiert, umgekehrt zur sonst im Projekt
|
||||
# ueblichen Konvention nein=1/ja=2).
|
||||
schlaf_hole_label_text = function(original_col, wert) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_character_)
|
||||
labels_attr = attr(original_col, "labels")
|
||||
if (is.null(labels_attr) || length(labels_attr) == 0) return(NA_character_)
|
||||
pos = which(as.vector(labels_attr) == as.numeric(wert[1]))
|
||||
if (length(pos) == 0) return(NA_character_)
|
||||
bereinige_text(names(labels_attr)[pos[1]])
|
||||
}
|
||||
|
||||
# Regel A: hoechste Stufe eines 3-stufigen Items, Label-Text beginnt mit "haeufig".
|
||||
schlaf_ist_hoechste_stufe = function(label_text) {
|
||||
if (is.null(label_text) || is.na(label_text)) return(FALSE)
|
||||
grepl(paste0("^h", intToUtf8(228), "ufig"), tolower(trimws(label_text)))
|
||||
}
|
||||
|
||||
# Regel B: Antwort eines dichotomen Items ist "ja".
|
||||
schlaf_ist_ja = function(label_text) {
|
||||
if (is.null(label_text) || is.na(label_text)) return(FALSE)
|
||||
identical(tolower(trimws(label_text)), "ja")
|
||||
}
|
||||
|
||||
# Baut eine einzelne Anzeigezeile fuer ein Item aus daten/zeile + Metadaten.
|
||||
schlaf_baue_item = function(daten, zeile, var, meta) {
|
||||
if (!(var %in% names(daten))) {
|
||||
return(list(var = var, nr = schlaf_nr_label(var), text = meta$fallback,
|
||||
anzeige = "nicht vorhanden im Datensatz", hervorheben = FALSE))
|
||||
}
|
||||
|
||||
original_col = daten[[var]]
|
||||
wert = zeile[[var]]
|
||||
fehlt = is.null(wert) || length(wert) == 0 || is.na(wert[1]) ||
|
||||
(is.character(wert[1]) && trimws(wert[1]) == "")
|
||||
text = schlaf_item_text(original_col, meta$fallback)
|
||||
|
||||
if (meta$typ %in% c("mc3", "dichotom")) {
|
||||
antwort_text = if (fehlt) NA_character_ else schlaf_hole_label_text(original_col, wert)
|
||||
anzeige = if (fehlt) "nicht angegeben" else
|
||||
if (is.na(antwort_text)) paste0("Rohwert: ", wert[1]) else antwort_text
|
||||
|
||||
hervorheben = FALSE
|
||||
if (!fehlt && !is.na(antwort_text)) {
|
||||
if (identical(meta$regel, "A")) hervorheben = schlaf_ist_hoechste_stufe(antwort_text)
|
||||
if (identical(meta$regel, "B")) hervorheben = schlaf_ist_ja(antwort_text)
|
||||
}
|
||||
} else {
|
||||
anzeige = if (fehlt) "nicht angegeben" else trimws(as.character(wert[1]))
|
||||
hervorheben = FALSE
|
||||
}
|
||||
|
||||
list(var = var, nr = schlaf_nr_label(var), text = text, anzeige = anzeige, hervorheben = hervorheben)
|
||||
}
|
||||
|
||||
# Leitet ein lesbares Nummer-Praefix aus dem Feldnamen ab (z.B. "1.", "12.1", "20 (von)").
|
||||
schlaf_nr_label = function(var) {
|
||||
suffix = sub("^schlaf_", "", var)
|
||||
if (grepl("^12_", suffix)) return(paste0("12.", as.integer(sub("^12_", "", suffix))))
|
||||
if (suffix == "20_von") return("20 (von)")
|
||||
if (suffix == "20_bis") return("20 (bis)")
|
||||
paste0(as.integer(suffix), ".")
|
||||
}
|
||||
|
||||
# Baut die vollstaendige Item-Anzeige (alle Abschnitte) fuer einen Datensatz.
|
||||
schlaf_baue_abschnitte = function(daten, zeile) {
|
||||
lapply(ABSCHNITTE, function(block) {
|
||||
items = lapply(block$vars, function(var) schlaf_baue_item(daten, zeile, var, ITEM_META[[var]]))
|
||||
list(titel = block$titel, items = items)
|
||||
})
|
||||
}
|
||||
|
||||
# Parst "HH:MM" oder "HH:MM:SS" zu Minuten seit Mitternacht (Sekunden werden
|
||||
# ignoriert), gibt NA zurueck statt eines Fehlers, damit einzelne fehlende/
|
||||
# unplausible Uhrzeiten als "nicht berechenbar" statt als Programmfehler
|
||||
# erscheinen.
|
||||
schlaf_zeit_zu_minuten = function(zeit_str) {
|
||||
zeit_str = trimws(as.character(zeit_str[1]))
|
||||
if (is.na(zeit_str) || zeit_str == "" || zeit_str == "NA") return(NA_real_)
|
||||
teile = strsplit(zeit_str, ":", fixed = TRUE)[[1]]
|
||||
if (length(teile) < 2) return(NA_real_)
|
||||
stunde = suppressWarnings(as.numeric(teile[1]))
|
||||
minute = suppressWarnings(as.numeric(teile[2]))
|
||||
if (is.na(stunde) || is.na(minute) || stunde < 0 || stunde > 23 || minute < 0 || minute > 59) return(NA_real_)
|
||||
stunde * 60 + minute
|
||||
}
|
||||
|
||||
# Differenz zweier HH:MM-Uhrzeiten in Minuten, mit Tagesuebergang: wenn die
|
||||
# Endzeit vor der Startzeit liegt, werden 24 Stunden addiert.
|
||||
schlaf_differenz_minuten = function(start_str, ende_str) {
|
||||
m_start = schlaf_zeit_zu_minuten(start_str)
|
||||
m_ende = schlaf_zeit_zu_minuten(ende_str)
|
||||
if (is.na(m_start) || is.na(m_ende)) return(NA_real_)
|
||||
if (m_ende < m_start) m_ende = m_ende + 24 * 60
|
||||
m_ende - m_start
|
||||
}
|
||||
|
||||
# Parst eine ganzzahlige oder dezimale String-Angabe (Komma oder Punkt), NA statt Fehler.
|
||||
schlaf_zahl_parse = function(x) {
|
||||
x_str = trimws(as.character(x[1]))
|
||||
if (is.na(x_str) || x_str == "" || x_str == "NA") return(NA_real_)
|
||||
x_str = gsub(",", ".", x_str, fixed = TRUE)
|
||||
suppressWarnings(as.numeric(x_str))
|
||||
}
|
||||
|
||||
# Formatiert Minuten neutral als "X Std. Y Min.", ohne jede Bewertung.
|
||||
schlaf_format_minuten = function(minuten) {
|
||||
if (is.null(minuten) || length(minuten) == 0 || is.na(minuten)) return("nicht berechenbar")
|
||||
vorzeichen = if (minuten < 0) "-" else ""
|
||||
minuten_abs = abs(round(minuten))
|
||||
paste0(vorzeichen, minuten_abs %/% 60, " Std. ", minuten_abs %% 60, " Min.")
|
||||
}
|
||||
|
||||
# Rein rechnerische, unbewertete Ableitung der Zeitangaben aus schlaf_22-schlaf_28.
|
||||
schlaf_berechne_zeiten = function(zeile) {
|
||||
bettgeh = if ("schlaf_22" %in% names(zeile)) zeile[["schlaf_22"]][1] else NA
|
||||
einschlaf = if ("schlaf_23" %in% names(zeile)) zeile[["schlaf_23"]][1] else NA
|
||||
aufwachen_n = if ("schlaf_24" %in% names(zeile)) schlaf_zahl_parse(zeile[["schlaf_24"]]) else NA_real_
|
||||
wieder_min = if ("schlaf_25" %in% names(zeile)) schlaf_zahl_parse(zeile[["schlaf_25"]]) else NA_real_
|
||||
aufwach_zeit = if ("schlaf_26" %in% names(zeile)) zeile[["schlaf_26"]][1] else NA
|
||||
bett_verlassen = if ("schlaf_27" %in% names(zeile)) zeile[["schlaf_27"]][1] else NA
|
||||
subjektiv_h = if ("schlaf_28" %in% names(zeile)) schlaf_zahl_parse(zeile[["schlaf_28"]]) else NA_real_
|
||||
|
||||
einschlaflatenz_min = schlaf_differenz_minuten(bettgeh, einschlaf)
|
||||
zeit_im_bett_min = schlaf_differenz_minuten(bettgeh, bett_verlassen)
|
||||
|
||||
wachzeit_min = if (is.na(aufwachen_n) || is.na(wieder_min)) NA_real_ else aufwachen_n * wieder_min
|
||||
|
||||
schlaffenster_min = schlaf_differenz_minuten(einschlaf, aufwach_zeit)
|
||||
schlafdauer_min = if (is.na(schlaffenster_min) || is.na(wachzeit_min)) NA_real_ else
|
||||
schlaffenster_min - wachzeit_min
|
||||
|
||||
subjektiv_min = if (is.na(subjektiv_h)) NA_real_ else subjektiv_h * 60
|
||||
|
||||
list(
|
||||
einschlaflatenz_text = schlaf_format_minuten(einschlaflatenz_min),
|
||||
zeit_im_bett_text = schlaf_format_minuten(zeit_im_bett_min),
|
||||
wachzeit_text = schlaf_format_minuten(wachzeit_min),
|
||||
schlafdauer_text = schlaf_format_minuten(schlafdauer_min),
|
||||
subjektiv_text = schlaf_format_minuten(subjektiv_min)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# 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;
|
||||
}
|
||||
.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;
|
||||
}
|
||||
.meta-block { margin-bottom: 10px; color: #555; font-size: 0.95em; }
|
||||
.meta-block strong { color: #222; }
|
||||
.item-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px;
|
||||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-zeile-auffaellig { background: #FFE0B2; border-radius: 4px; padding-left: 6px; padding-right: 6px; }
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 60px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.item-antwort { color: #333; font-weight: 600; font-size: 0.92em; min-width: 170px; text-align: right; flex-shrink: 0; }
|
||||
.item-antwort-leer { color: #888; font-style: italic; font-weight: 400; }
|
||||
.kontext-zeile {
|
||||
display: flex; gap: 8px; align-items: baseline;
|
||||
padding: 5px 0; color: #444; font-size: 0.93em; border-bottom: 1px solid #F5F5F5;
|
||||
}
|
||||
.kontext-label { font-weight: 600; color: #333; min-width: 280px; }
|
||||
.hinweis-info {
|
||||
background: #F5F5F5; border-left: 5px solid #9E9E9E;
|
||||
padding: 10px 16px; border-radius: 4px; color: #555;
|
||||
margin-bottom: 12px; font-size: 0.9em;
|
||||
}
|
||||
.disclaimer-text {
|
||||
font-size: 0.82em; color: #777; font-style: italic;
|
||||
margin-top: 14px; border-top: 1px solid rgba(0,0,0,.1); padding-top: 8px;
|
||||
}
|
||||
"
|
||||
|
||||
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("Fragebogen zum Schlafverhalten"),
|
||||
tags$p("Deskriptive Uebersicht der Einzelantworten - kein Score, kein Cutoff, keine Klassifikation")
|
||||
),
|
||||
|
||||
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_schlafverhalten_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 = 10.5)
|
||||
fp_normal = fp_text(font.size = 10.5)
|
||||
fp_normal_auf = fp_text(font.size = 10.5, shading.color = HERVORHEBUNG_FARBE)
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Fragebogen zum Schlafverhalten", 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)
|
||||
))
|
||||
if (!is.null(erg$info_mehrere)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(erg$info_mehrere, fp_text(font.size = 9.5, italic = TRUE, color = "#555555"))
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
for (block in erg$abschnitte) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(block$titel, fp_abschnitt)))
|
||||
for (item in block$items) {
|
||||
fp_wert = if (item$hervorheben) fp_normal_auf else fp_normal
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(item$nr, " ", item$text, ": "), fp_label),
|
||||
ftext(item$anzeige, fp_wert)
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
z = erg$zeiten
|
||||
doc = body_add_fpar(doc, fpar(ftext("Berechnete Zeitangaben (deskriptiv)", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext("Einschlaflatenz: ", fp_label), ftext(z$einschlaflatenz_text, fp_normal)))
|
||||
doc = body_add_fpar(doc, fpar(ftext("Zeit im Bett gesamt: ", fp_label), ftext(z$zeit_im_bett_text, fp_normal)))
|
||||
doc = body_add_fpar(doc, fpar(ftext("Naechtliche Wachzeit (grobe Schaetzung): ", fp_label), ftext(z$wachzeit_text, fp_normal)))
|
||||
doc = body_add_fpar(doc, fpar(ftext("Geschaetzte Schlafdauer: ", fp_label), ftext(z$schlafdauer_text, fp_normal)))
|
||||
doc = body_add_fpar(doc, fpar(ftext("Subjektiv benoetigte Schlafstunden (schlaf_28, zum Vergleich): ", fp_label), ftext(z$subjektiv_text, fp_normal)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(SCHLAF_DISCLAIMER, fp_disclaimer)))
|
||||
|
||||
doc
|
||||
}
|
||||
|
||||
|
||||
# Server ####
|
||||
|
||||
server = function(input, output, session) {
|
||||
|
||||
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 = "leere_eingabe", meldung = "Bitte Chiffre oder Pseudonym eingeben."))
|
||||
}
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||||
return(list(typ = "format_fehler", chiffre = chiffre))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(typ = "pfad_fehler",
|
||||
meldung = paste0("Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(typ = "pfad_fehler",
|
||||
meldung = paste0("Pseudonym-Skript nicht gefunden:\n", 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(typ = "skript_fehler", meldung = ok$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()
|
||||
wd_ziel = if (!is.null(db_ordner)) db_ordner else
|
||||
dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
setwd(wd_ziel)
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
|
||||
ok = tryCatch({
|
||||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok$ok) return(list(typ = "skript_fehler", meldung = ok$msg))
|
||||
|
||||
if (!exists("daten_schlafverhalten", envir = .GlobalEnv)) {
|
||||
return(list(typ = "daten_fehlen",
|
||||
meldung = "Objekt 'daten_schlafverhalten' nach dem Sourcen nicht gefunden. Bitte Download-Skript pruefen."))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||||
return(list(typ = "daten_fehlen",
|
||||
meldung = "Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript pruefen."))
|
||||
}
|
||||
|
||||
daten_schlafverhalten = get("daten_schlafverhalten", envir = .GlobalEnv)
|
||||
pseudo = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
if (!("session" %in% names(daten_schlafverhalten))) {
|
||||
return(list(typ = "daten_fehlen",
|
||||
meldung = "Spalte 'session' in 'daten_schlafverhalten' nicht gefunden. Bitte Download-Skript pruefen."))
|
||||
}
|
||||
|
||||
alle_session_ids = character(0)
|
||||
if (nchar(chiffre) > 0) {
|
||||
treffer_ps = pseudo[pseudo$chiffre == chiffre, ]
|
||||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||||
}
|
||||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||||
alle_session_ids = trimws(input$pseudonym)
|
||||
if (nchar(chiffre) == 0) {
|
||||
pw_treffer = pseudo[pseudo$pseudonym == trimws(input$pseudonym), ]
|
||||
if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
|
||||
}
|
||||
}
|
||||
|
||||
if (length(alle_session_ids) == 0 || all(is.na(alle_session_ids)) ||
|
||||
all(trimws(as.character(alle_session_ids)) == "")) {
|
||||
return(list(typ = "kein_treffer", meldung = "Chiffre/Pseudonym nicht gefunden."))
|
||||
}
|
||||
|
||||
treffer_dat = daten_schlafverhalten[daten_schlafverhalten$session %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(typ = "kein_treffer",
|
||||
meldung = paste0("Kein Datensatz zum Schlafverhalten fuer Chiffre '", chiffre, "' gefunden. ",
|
||||
"(", length(alle_session_ids), " Pseudonym(e) geprueft)")))
|
||||
}
|
||||
|
||||
info_mehrere = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
if (SPALTE_AUSFUELLDATUM %in% names(treffer_dat)) {
|
||||
treffer_dat = treffer_dat[order(treffer_dat[[SPALTE_AUSFUELLDATUM]], decreasing = TRUE), ]
|
||||
datum_neu = tryCatch(
|
||||
format(as.POSIXct(treffer_dat[[SPALTE_AUSFUELLDATUM]][1]), "%d.%m.%Y %H:%M"),
|
||||
error = function(e) "unbekanntes Datum"
|
||||
)
|
||||
info_mehrere = paste0(
|
||||
"Mehrere Ausfuellungen gefunden (", n, " Eintraege). ",
|
||||
"Angezeigt wird die neueste vom ", datum_neu, "."
|
||||
)
|
||||
} else {
|
||||
info_mehrere = paste0(
|
||||
"Mehrere Ausfuellungen gefunden (", n, " Eintraege). Zeitstempel-Spalte '",
|
||||
SPALTE_AUSFUELLDATUM, "' nicht gefunden, chronologische Sortierung nicht moeglich - ",
|
||||
"der erste gefundene Eintrag wird angezeigt."
|
||||
)
|
||||
}
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
|
||||
ausfuelldatum = if (SPALTE_AUSFUELLDATUM %in% names(zeile)) {
|
||||
tryCatch(
|
||||
format(as.POSIXct(zeile[[SPALTE_AUSFUELLDATUM]][1]), "%d.%m.%Y"),
|
||||
error = function(e) "unbekannt"
|
||||
)
|
||||
} else "unbekannt"
|
||||
|
||||
auswertung_res = tryCatch(
|
||||
list(ok = TRUE, abschnitte = schlaf_baue_abschnitte(daten_schlafverhalten, zeile),
|
||||
zeiten = schlaf_berechne_zeiten(zeile)),
|
||||
error = function(e) list(ok = FALSE, msg = e$message)
|
||||
)
|
||||
if (!auswertung_res$ok) {
|
||||
return(list(typ = "berechnung_fehler", meldung = auswertung_res$msg))
|
||||
}
|
||||
|
||||
list(
|
||||
typ = "erfolg",
|
||||
chiffre = chiffre,
|
||||
ausfuelldatum = ausfuelldatum,
|
||||
info_mehrere = info_mehrere,
|
||||
abschnitte = auswertung_res$abschnitte,
|
||||
zeiten = auswertung_res$zeiten
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
if (erg$typ == "leere_eingabe") {
|
||||
div(class = "alert-fehler", erg$meldung)
|
||||
} else if (erg$typ == "format_fehler") {
|
||||
div(class = "alert-fehler",
|
||||
paste0("Ungueltige Chiffre '", erg$chiffre, "'. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123)."))
|
||||
} else if (erg$typ == "pfad_fehler") {
|
||||
div(class = "alert-fehler", erg$meldung)
|
||||
} else if (erg$typ == "skript_fehler") {
|
||||
div(class = "alert-fehler", paste0("Fehler beim Ausfuehren eines Skripts: ", erg$meldung))
|
||||
} else if (erg$typ == "daten_fehlen") {
|
||||
div(class = "alert-fehler", erg$meldung)
|
||||
} else if (erg$typ == "kein_treffer") {
|
||||
div(class = "alert-fehler", erg$meldung)
|
||||
} else if (erg$typ == "berechnung_fehler") {
|
||||
div(class = "alert-fehler", paste0("Fehler bei der Aufbereitung: ", erg$meldung))
|
||||
}
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
if (erg$typ != "erfolg" || is.null(erg$info_mehrere)) return(NULL)
|
||||
div(class = "alert-warnung", erg$info_mehrere)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
if (erg$typ != "erfolg") return(NULL)
|
||||
|
||||
baue_item_zeile = function(item) {
|
||||
klasse_antwort = paste0("item-antwort",
|
||||
if (item$anzeige %in% c("nicht angegeben", "nicht vorhanden im Datensatz")) " item-antwort-leer" else "")
|
||||
klasse_zeile = paste0("item-zeile", if (item$hervorheben) " item-zeile-auffaellig" else "")
|
||||
div(class = klasse_zeile,
|
||||
div(class = "item-nr", item$nr),
|
||||
div(class = "item-text", item$text),
|
||||
div(class = klasse_antwort, item$anzeige)
|
||||
)
|
||||
}
|
||||
|
||||
abschnitt_karten = lapply(erg$abschnitte, function(block) {
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", block$titel),
|
||||
div(lapply(block$items, baue_item_zeile))
|
||||
)
|
||||
})
|
||||
|
||||
z = erg$zeiten
|
||||
zeiten_karte = div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Berechnete Zeitangaben (deskriptiv)"),
|
||||
div(class = "hinweis-info",
|
||||
"Rein rechnerische Ableitung aus den Uhrzeit- und Zahlenangaben, ohne jede Bewertung als zu kurz/ausreichend/zu lang."),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Einschlaflatenz:"), div(z$einschlaflatenz_text)),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Zeit im Bett gesamt:"), div(z$zeit_im_bett_text)),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Naechtliche Wachzeit (grobe Schaetzung):"), div(z$wachzeit_text)),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Geschaetzte Schlafdauer:"), div(z$schlafdauer_text)),
|
||||
div(class = "kontext-zeile", div(class = "kontext-label", "Subjektiv benoetigte Schlafstunden (schlaf_28, zum Vergleich):"), div(z$subjektiv_text))
|
||||
)
|
||||
|
||||
tagList(
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Kopfdaten"),
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), erg$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfuelldatum: "), erg$ausfuelldatum
|
||||
)
|
||||
),
|
||||
abschnitt_karten,
|
||||
zeiten_karte,
|
||||
div(class = "disclaimer-text", SCHLAF_DISCLAIMER)
|
||||
)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
chiffre_esc = if (is.list(erg) && identical(erg$typ, "erfolg") && nchar(erg$chiffre) > 0)
|
||||
erg$chiffre else "export"
|
||||
ausfuelldatum_fn = if (is.list(erg) && identical(erg$typ, "erfolg") && !is.null(erg$ausfuelldatum))
|
||||
tryCatch(
|
||||
format(as.Date(erg$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d"),
|
||||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||||
)
|
||||
else
|
||||
format(Sys.Date(), "%Y%m%d")
|
||||
paste0("Schlafverhalten_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
daten_ok = is.list(erg) && identical(erg$typ, "erfolg")
|
||||
if (!daten_ok) {
|
||||
doc = read_docx()
|
||||
doc = body_add_par(doc,
|
||||
"Kein Datensatz geladen. Bitte zuerst Chiffre oder Pseudonym eingeben und 'Auswerten' klicken.",
|
||||
style = "Normal")
|
||||
print(doc, target = file)
|
||||
return()
|
||||
}
|
||||
doc = tryCatch(
|
||||
erstelle_schlafverhalten_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)
|
||||
Loading…
Add table
Add a link
Reference in a new issue