Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
BIN
VDS23/.RData
Normal file
BIN
VDS23/.RData
Normal file
Binary file not shown.
1
VDS23/.Rprofile
Normal file
1
VDS23/.Rprofile
Normal file
|
|
@ -0,0 +1 @@
|
|||
source("renv/activate.R")
|
||||
13
VDS23/VDS23.Rproj
Normal file
13
VDS23/VDS23.Rproj
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
Version: 1.0
|
||||
|
||||
RestoreWorkspace: Default
|
||||
SaveWorkspace: Default
|
||||
AlwaysSaveHistory: Default
|
||||
|
||||
EnableCodeIndexing: Yes
|
||||
UseSpacesForTab: Yes
|
||||
NumSpacesForTab: 2
|
||||
Encoding: UTF-8
|
||||
|
||||
RnwWeave: Sweave
|
||||
LaTeX: pdfLaTeX
|
||||
994
VDS23/app.R
Normal file
994
VDS23/app.R
Normal file
|
|
@ -0,0 +1,994 @@
|
|||
# Praeambel ####
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_vds23.R" # liefert: daten_vds23
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
VDS23_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Es liegen keine Normwerte oder Cutoffs fuer dieses ",
|
||||
"Instrument vor; die dargestellten Werte sind deskriptive Positionsangaben auf ",
|
||||
"der 0 bis 5 Skala, keine Vergleichswerte gegen eine Referenzstichprobe. Die ",
|
||||
"Interpretation obliegt der behandelnden Person."
|
||||
)
|
||||
VDS23_DISCLAIMER = gsub("fuer", "für", VDS23_DISCLAIMER, fixed = TRUE)
|
||||
|
||||
VDS23_STUFEN_TEXTE = c("nicht", "kaum", "etwas", "deutlich", "sehr", "extrem")
|
||||
|
||||
# 6 Stufen (0-5), gruen -> dunkelrot. Generische Klassennamen .stufe-badge-0 .. -5,
|
||||
# siehe app_css weiter unten.
|
||||
VDS23_BADGE_FARBEN = c(
|
||||
"0" = "#4CAF50", # gruen
|
||||
"1" = "#E6EE9C", # helles Gelbgruen
|
||||
"2" = "#F48FB1", # helles Rosa
|
||||
"3" = "#EF5350", # mittleres Rot
|
||||
"4" = "#C62828", # kraeftiges Rot
|
||||
"5" = "#4A0000" # dunkles Rot
|
||||
)
|
||||
VDS23_BADGE_TEXT_FARBEN = c(
|
||||
"0" = "white", "1" = "#333333", "2" = "#333333",
|
||||
"3" = "white", "4" = "white", "5" = "white"
|
||||
)
|
||||
|
||||
# Item-Faktor-Zuordnung, fest aus dem Testmanual uebernommen (nicht aus dem
|
||||
# Itemtext neu abgeleitet). 11 Items sind doppelt zugeordnet, 5 Items keinem
|
||||
# Faktor (21, 43, 54, 55, 62).
|
||||
vds23_faktoren = list(
|
||||
"1" = list(
|
||||
name = "Beziehung nimmt Schaden",
|
||||
items = c(3, 6, 7, 11, 12, 13, 14, 15, 16, 17, 18, 19, 22, 29, 30, 32, 37, 38, 44, 47, 48, 50, 51, 58, 59)
|
||||
),
|
||||
"2" = list(
|
||||
name = "Abgrenzung gelingt nicht",
|
||||
items = c(17, 18, 23, 24, 25, 26, 40, 41, 42, 49, 52, 53, 60)
|
||||
),
|
||||
"3" = list(
|
||||
name = "Bedürfnis-Frustration",
|
||||
items = c(33, 35, 39, 45, 51, 53, 56, 57, 58, 61)
|
||||
),
|
||||
"4" = list(
|
||||
name = "Abgelehnt werden",
|
||||
items = c(2, 4, 5, 10, 15, 27, 28, 35, 38)
|
||||
),
|
||||
"5" = list(
|
||||
name = "Einfluss-Verlust",
|
||||
items = c(8, 9, 31, 46, 49, 63)
|
||||
),
|
||||
"6" = list(
|
||||
name = "Unterlegen sein",
|
||||
items = c(1, 20, 25, 33, 34, 36)
|
||||
)
|
||||
)
|
||||
|
||||
# Kontrollsumme: 25 + 13 + 10 + 9 + 6 + 6 = 69 Zuordnungen bei 63 Items.
|
||||
# Bei Abweichung sofort abbrechen statt still weiterzurechnen, das wuerde
|
||||
# einen Copy-Paste-Fehler in der Struktur oben sonst verschleiern.
|
||||
.vds23_kontrollsumme = sum(sapply(vds23_faktoren, function(f) length(f$items)))
|
||||
if (.vds23_kontrollsumme != 69) {
|
||||
stop(
|
||||
"VDS23: Kontrollsumme der Item-Faktor-Zuordnung ist ", .vds23_kontrollsumme,
|
||||
", erwartet 69. Bitte 'vds23_faktoren' pruefen (Copy-Paste-Fehler?)."
|
||||
)
|
||||
}
|
||||
|
||||
VDS23_OHNE_FAKTOR = c(21, 43, 54, 55, 62)
|
||||
|
||||
vds23_itemtexte = c(
|
||||
"01" = "Ich allein bin",
|
||||
"02" = "Ich mit wenig vertrauten Personen zu tun habe",
|
||||
"03" = "Ich mit einer wichtigen Bezugsperson zu tun habe",
|
||||
"04" = "Ich nicht erkennen kann, worauf es ankommt",
|
||||
"05" = "Andere darauf achten, was ich wie tue",
|
||||
"06" = "Andere etwas von mir erwarten, das ich nicht kann",
|
||||
"07" = "Andere etwas von mir erwarten, das ich nicht will",
|
||||
"08" = "Ich Nein sagen müsste",
|
||||
"09" = "Ich Forderungen stellen müsste",
|
||||
"10" = "Ich Kontakt mit jemandem aufnehmen müsste, jemand ansprechen müsste",
|
||||
"11" = "Andere mich links liegen lassen",
|
||||
"12" = "Andere mich nicht akzeptieren, nicht aufnehmen",
|
||||
"13" = "Andere gegen mich vorgehen",
|
||||
"14" = "Andere mir etwas vorwerfen, mich kritisieren",
|
||||
"15" = "Andere mit mir konkurrieren, rivalisieren",
|
||||
"16" = "Andere kein Verständnis für mich haben",
|
||||
"17" = "Andere mich ausnutzen wollen",
|
||||
"18" = "Andere mich übervorteilen, betrügen wollen",
|
||||
"19" = "Andere nicht einsehen wollen, dass ich Recht habe",
|
||||
"20" = "Andere sich mir einfach entziehen",
|
||||
"21" = "Sich andere mit Ausreden rauswinden",
|
||||
"22" = "Andere mich beschämen (die mir peinlich sind)",
|
||||
"23" = "Ich meine Pflicht nicht erfülle, erfüllen kann",
|
||||
"24" = "Ich nicht erreiche, was ich will",
|
||||
"25" = "Mich in meinen Kräften oder Fähigkeiten überfordern",
|
||||
"26" = "Ich versage",
|
||||
"27" = "Ich im Mittelpunkt stehe",
|
||||
"28" = "Ich einen Fehler zugeben müsste",
|
||||
"29" = "Ich bei etwas Unrechtem ertappt werden",
|
||||
"30" = "Ich unangenehm auffalle",
|
||||
"31" = "Die Harmonie gestört ist",
|
||||
"32" = "Ich einen großen Verlust erleide",
|
||||
"33" = "Ich etwas hergeben muss",
|
||||
"34" = "Andere besser sind als ich",
|
||||
"35" = "Ich eine schwierige Entscheidung treffen sollte",
|
||||
"36" = "Ich tun muss, was andere mir anordnen",
|
||||
"37" = "Ich es nicht schaffe, attraktiv genug zu sein",
|
||||
"38" = "Mir meine Gefühle einen Strich durch die Rechnung machen",
|
||||
"39" = "Sehr intim sind",
|
||||
"40" = "Andere meine Grenzen überschreiten, übergriffig werden",
|
||||
"41" = "Ich eingeengt und unfrei bin",
|
||||
"42" = "Andere mir zu nahe kommen",
|
||||
"43" = "Ich nicht bekomme, was ich brauche, so viel wie ich brauche",
|
||||
"44" = "Ich im Stich gelassen werde",
|
||||
"45" = "Meine Forderungen abgelehnt werden",
|
||||
"46" = "Sich andere nicht durch mich beeinflussen lassen",
|
||||
"47" = "Es mir nicht gelingt, die Kontrolle über mich zu bewahren",
|
||||
"48" = "Meine Liebesbeziehung in Gefahr ist",
|
||||
"49" = "Umgangsregeln nicht eingehalten werden",
|
||||
"50" = "Meine Gefühle verletzt werden",
|
||||
"51" = "Ich nicht gebraucht werde",
|
||||
"52" = "Meine Meinungsfreiheit eingeschränkt wird",
|
||||
"53" = "Meine Sicherheit und Existenz bedroht ist",
|
||||
"54" = "Mein Glaube angefochten wird",
|
||||
"55" = "Gefahr besteht, meine Familie zu verlieren",
|
||||
"56" = "Ich gehindert werde, meinen Genüssen nachzugehen",
|
||||
"57" = "Ich wichtige innere Gebote nicht eingehalten habe",
|
||||
"58" = "Ich wichtige Verbote überschritten habe",
|
||||
"59" = "Ich in einem großen Konflikt stehe",
|
||||
"60" = "Die ewig wiederkehrenden Probleme mit einer wichtigen Bezugsperson auftreten",
|
||||
"61" = "Ein sexuelles Problem auftritt",
|
||||
"62" = "Meine Wünsche erfüllt, meine Bedürfnisse befriedigt werden",
|
||||
"63" = "Jemand gut zu mir ist"
|
||||
)
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
|
||||
|
||||
# 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 ####
|
||||
|
||||
# OFFENER PUNKT FUER ERSTEN TESTLAUF (siehe Projekt-Notizen, Abschnitt 16.1):
|
||||
# Ob formr mc-Felder beim Export den Choice-Text oder den 1-basierten
|
||||
# Choice-Index liefert, ist fuer diese Instanz nicht verifiziert. Diese
|
||||
# Funktion deckt beide Faelle robust ueber das labels-Attribut der
|
||||
# ORIGINAL-Spalte ab (nicht ueber hartkodierte Zahlenwerte) und liefert bei
|
||||
# unbekanntem Format NA statt einer geratenen Zahl.
|
||||
vds23_wert_inhaltlich = function(rohwert, labels_attr) {
|
||||
mapping_text = c(
|
||||
"nicht" = 0L, "kaum" = 1L, "etwas" = 2L,
|
||||
"deutlich" = 3L, "sehr" = 4L, "extrem" = 5L
|
||||
)
|
||||
|
||||
if (is.null(rohwert) || length(rohwert) == 0 || is.na(rohwert[1])) {
|
||||
return(list(wert = NA_integer_, status = "na"))
|
||||
}
|
||||
|
||||
roh_chr = trimws(as.character(rohwert[1]))
|
||||
roh_lower = tolower(roh_chr)
|
||||
roh_num = suppressWarnings(as.numeric(roh_chr))
|
||||
|
||||
# Fall A: Rohwert ist bereits direkt einer der 6 bekannten Choice-Texte.
|
||||
if (roh_lower %in% names(mapping_text)) {
|
||||
return(list(wert = unname(mapping_text[[roh_lower]]), status = "text_direkt"))
|
||||
}
|
||||
|
||||
if (!is.null(labels_attr) && length(labels_attr) > 0) {
|
||||
lbl_namen = tolower(trimws(names(labels_attr)))
|
||||
lbl_werte = as.vector(labels_attr)
|
||||
|
||||
pos = if (!is.na(roh_num)) which(lbl_werte == roh_num) else which(lbl_namen == roh_lower)
|
||||
|
||||
if (length(pos) > 0) {
|
||||
choice_text = lbl_namen[pos[1]]
|
||||
# Fall B: Rohwert entspricht (ueber labels) einem bekannten Choice-Text.
|
||||
if (choice_text %in% names(mapping_text)) {
|
||||
return(list(wert = unname(mapping_text[[choice_text]]), status = "labels_text"))
|
||||
}
|
||||
# Fall C: Choice-Text nicht erkannt, aber die sortierte Position des
|
||||
# Rohwerts unter allen labels-Werten ergibt einen 1-basierten Index 1-6.
|
||||
lbl_sortiert = sort(lbl_werte)
|
||||
idx_pos = which(lbl_sortiert == lbl_werte[pos[1]])
|
||||
if (length(idx_pos) > 0 && idx_pos[1] >= 1 && idx_pos[1] <= 6) {
|
||||
return(list(wert = as.integer(idx_pos[1] - 1L), status = "labels_index"))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Fall D: kein (nutzbares) labels-Attribut, Rohwert ist eine Zahl 1-6 ->
|
||||
# 1-basierter Index wird angenommen.
|
||||
if (!is.na(roh_num) && roh_num >= 1 && roh_num <= 6 && roh_num == round(roh_num)) {
|
||||
return(list(wert = as.integer(roh_num - 1L), status = "index_fallback"))
|
||||
}
|
||||
|
||||
# Fall E: Rohwert ist bereits eine Zahl 0-5 (schon inhaltlich kodiert).
|
||||
if (!is.na(roh_num) && roh_num >= 0 && roh_num <= 5 && roh_num == round(roh_num)) {
|
||||
return(list(wert = as.integer(roh_num), status = "bereits_inhaltlich"))
|
||||
}
|
||||
|
||||
list(wert = NA_integer_, status = "unbekannt")
|
||||
}
|
||||
|
||||
# Faktor-Score = arithmetisches Mittel der zugeordneten Item-Rohwerte
|
||||
# (0-5), kein Reverse-Coding. na.rm = TRUE fuer den defensiven Fall
|
||||
# einzelner fehlender Werte trotz Pflichtfeld-Annahme.
|
||||
vds23_faktor_score = function(werte_vektor, item_nummern) {
|
||||
werte = werte_vektor[item_nummern]
|
||||
n_vorhanden = sum(!is.na(werte))
|
||||
n_gesamt = length(werte)
|
||||
score = if (n_vorhanden > 0) mean(werte, na.rm = TRUE) else NA_real_
|
||||
list(score = score, n_vorhanden = n_vorhanden, n_gesamt = n_gesamt)
|
||||
}
|
||||
|
||||
# Choice-Format lt. vds23.xlsx fuer vds23_top5_auswahl: "N. Itemtext" (z.B.
|
||||
# "5. Andere darauf achten, was ich wie tue"). Trennzeichen zwischen mehreren
|
||||
# Ausgewaehlten ist in dieser formr-Instanz weiterhin nicht live verifiziert,
|
||||
# es wird defensiv an ",", ";" und "|" gesplittet. Der Itemtext wird pro
|
||||
# Fragment IMMER aus der festen vds23_itemtexte-Tabelle nachgeschlagen (ueber
|
||||
# die per Regex gezogene fuehrende Nummer), nicht aus dem Fragment selbst
|
||||
# uebernommen - das liefert auch dann den vollen Text, wenn formr ein
|
||||
# Fragment nur als blosse Nummer ("5" statt "5. Andere darauf achten ...")
|
||||
# exportiert. Nur wenn weder eine fuehrende Nummer noch ein exakter
|
||||
# Text-Treffer gefunden wird, bleibt es beim unveraenderten Rohtext statt
|
||||
# einer Ratewert-Zuordnung.
|
||||
vds23_parse_top5 = function(rohtext, itemtexte) {
|
||||
leer_ergebnis = data.frame(
|
||||
nummer = integer(0), text = character(0), roh = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
if (is.null(rohtext) || length(rohtext) == 0 || is.na(rohtext[1]) ||
|
||||
trimws(as.character(rohtext[1])) == "") {
|
||||
return(leer_ergebnis)
|
||||
}
|
||||
|
||||
txt = trimws(as.character(rohtext[1]))
|
||||
fragmente = trimws(strsplit(txt, "[,;|]")[[1]])
|
||||
fragmente = fragmente[nchar(fragmente) > 0]
|
||||
if (length(fragmente) == 0) return(leer_ergebnis)
|
||||
|
||||
itemtexte_lower = tolower(trimws(itemtexte))
|
||||
|
||||
zeilen = lapply(fragmente, function(frag) {
|
||||
frag_trim = trimws(frag)
|
||||
|
||||
# Fall A: Fragment beginnt mit der Itemnummer (mit oder ohne Text
|
||||
# dahinter) - Text immer aus der Itemtexte-Tabelle nachschlagen.
|
||||
nr_match = regmatches(frag_trim, regexpr("^[0-9]{1,2}", frag_trim))
|
||||
if (length(nr_match) > 0 && nchar(nr_match) > 0) {
|
||||
nr = as.integer(nr_match)
|
||||
key = sprintf("%02d", nr)
|
||||
if (nr >= 1 && nr <= 63 && key %in% names(itemtexte)) {
|
||||
return(data.frame(nummer = nr, text = unname(itemtexte[[key]]), roh = frag,
|
||||
stringsAsFactors = FALSE))
|
||||
}
|
||||
}
|
||||
|
||||
# Fall B: Fragment ist der vollstaendige Itemtext ohne fuehrende Nummer.
|
||||
frag_lower = tolower(frag_trim)
|
||||
treffer = which(itemtexte_lower == frag_lower)
|
||||
if (length(treffer) == 1) {
|
||||
return(data.frame(nummer = as.integer(names(itemtexte)[treffer]),
|
||||
text = unname(itemtexte[treffer]), roh = frag,
|
||||
stringsAsFactors = FALSE))
|
||||
}
|
||||
|
||||
data.frame(nummer = NA_integer_, text = NA_character_, roh = frag,
|
||||
stringsAsFactors = FALSE)
|
||||
})
|
||||
do.call(rbind, zeilen)
|
||||
}
|
||||
|
||||
vds23_badge_klasse = function(wert) {
|
||||
if (is.na(wert)) return("stufe-badge-na")
|
||||
paste0("stufe-badge-", max(0L, min(5L, as.integer(wert))))
|
||||
}
|
||||
|
||||
vds23_badge_text = function(wert) {
|
||||
if (is.na(wert)) return("k. A.")
|
||||
VDS23_STUFEN_TEXTE[max(0L, min(5L, as.integer(wert))) + 1L]
|
||||
}
|
||||
|
||||
# Neutrale 0-5-Achse ohne Farbzonen (kein Cutoff dokumentiert), nur eine
|
||||
# Markierung an der Position des Faktor-Mittelwerts.
|
||||
vds23_achse_plot = function(score) {
|
||||
ggplot() +
|
||||
geom_segment(aes(x = 0, xend = 5, y = 0, yend = 0), color = "#BDBDBD", linewidth = 1.2) +
|
||||
geom_point(aes(x = 0:5, y = 0), color = "#9E9E9E", size = 2) +
|
||||
geom_segment(aes(x = score, xend = score, y = -0.35, yend = 0.35),
|
||||
color = AKZENT_FARBE, linewidth = 2.2) +
|
||||
geom_label(aes(x = score, y = 0.8, label = format(round(score, 1), nsmall = 1)),
|
||||
fill = AKZENT_FARBE, color = "white", fontface = "bold",
|
||||
linewidth = 0, size = 4) +
|
||||
scale_x_continuous(limits = c(-0.3, 5.3), breaks = 0:5) +
|
||||
scale_y_continuous(limits = c(-0.6, 1.15)) +
|
||||
theme_minimal(base_size = 12) +
|
||||
theme(
|
||||
axis.text.y = element_blank(),
|
||||
axis.ticks.y = element_blank(),
|
||||
panel.grid.major.y = element_blank(),
|
||||
panel.grid.minor = element_blank(),
|
||||
axis.title.y = element_blank(),
|
||||
axis.title.x = element_blank(),
|
||||
plot.margin = margin(t = 5, r = 10, b = 5, l = 10)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# 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; }
|
||||
.faktor-score-block { display: flex; align-items: baseline; gap: 14px; margin-bottom: 6px; }
|
||||
.faktor-score-zahl { font-size: 2.0rem; font-weight: 800; color: #8B2635; }
|
||||
.faktor-score-label { color: #555; font-size: 0.9em; }
|
||||
.faktor-missing-hinweis { font-size: 0.85em; color: #E65100; margin-bottom: 8px; }
|
||||
.item-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px;
|
||||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-zeile:last-child { border-bottom: none; }
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 26px; flex-shrink: 0; }
|
||||
.item-text-block { flex: 1; }
|
||||
.item-text { color: #333; font-size: 0.92em; }
|
||||
.item-beispiel {
|
||||
color: #777; font-size: 0.86em; font-style: italic; margin-top: 2px;
|
||||
}
|
||||
.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-color: #4CAF50; color: white; }
|
||||
.stufe-badge-1 { background-color: #E6EE9C; color: #333333; }
|
||||
.stufe-badge-2 { background-color: #F48FB1; color: #333333; }
|
||||
.stufe-badge-3 { background-color: #EF5350; color: white; }
|
||||
.stufe-badge-4 { background-color: #C62828; color: white; }
|
||||
.stufe-badge-5 { background-color: #4A0000; color: white; }
|
||||
.stufe-badge-na { background-color: #E0E0E0; color: #555555; }
|
||||
.ohne-faktor-hinweis { font-size: 0.85em; color: #777; font-style: italic; margin-bottom: 10px; }
|
||||
.top5-liste { margin: 6px 0 0 0; padding-left: 20px; }
|
||||
.top5-eintrag { padding: 3px 0; color: #333; font-size: 0.94em; }
|
||||
.freitext-block { margin-bottom: 14px; }
|
||||
.freitext-frage { font-weight: 600; color: #8B2635; font-size: 0.95em; margin-bottom: 3px; }
|
||||
.freitext-antwort { color: #333; font-size: 0.93em; white-space: pre-wrap; line-height: 1.5; }
|
||||
.qualitativ-hinweis {
|
||||
font-size: 0.82em; color: #777; font-style: italic;
|
||||
margin-bottom: 12px; border-bottom: 1px dashed #ddd; padding-bottom: 8px;
|
||||
}
|
||||
.disclaimer-zeile {
|
||||
font-size: 0.82em; color: #777; font-style: italic;
|
||||
margin-top: 10px; 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("VDS23 – Situationsanalyse"),
|
||||
tags$p("63 Items zu unangenehmen Situationen, 6 Faktoren, keine Normwerte")
|
||||
),
|
||||
|
||||
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_vds23_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_beispiel = fp_text(font.size = 9.5, italic = TRUE, color = "#777777")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("VDS23, Situationsanalyse", fp_titel)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label),
|
||||
ftext(erg$chiffre, fp_normal),
|
||||
ftext(" Ausfülldatum: ", 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 = 10, italic = TRUE, color = "#555555"))
|
||||
))
|
||||
}
|
||||
if (!is.null(erg$kodierwarnung)) {
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(erg$kodierwarnung, fp_text(font.size = 10, italic = TRUE, color = "#BF360C"))
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
for (fe in erg$faktor_ergebnisse) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(fe$name, fp_abschnitt)))
|
||||
|
||||
score_txt = if (is.na(fe$score)) "keine auswertbaren Items" else
|
||||
paste0(format(round(fe$score, 1), nsmall = 1), " auf der Skala 0 bis 5")
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Faktor-Mittelwert: ", fp_label),
|
||||
ftext(score_txt, fp_normal)
|
||||
))
|
||||
if (!is.na(fe$score) && fe$n_vorhanden < fe$n_gesamt) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
paste0("Faktor-Score basiert auf ", fe$n_vorhanden, " von ", fe$n_gesamt, " Items."),
|
||||
fp_text(font.size = 9.5, italic = TRUE, color = "#BF360C")
|
||||
)))
|
||||
}
|
||||
|
||||
for (r in seq_len(nrow(fe$items))) {
|
||||
zeile = fe$items[r, ]
|
||||
badge_key = if (is.na(zeile$wert)) NA_character_ else
|
||||
as.character(max(0L, min(5L, as.integer(zeile$wert))))
|
||||
if (is.na(badge_key)) {
|
||||
fp_badge = fp_text(color = "#555555", bold = TRUE, shading.color = "#E0E0E0", font.size = 10)
|
||||
badge_txt = "k. A."
|
||||
} else {
|
||||
fp_badge = fp_text(
|
||||
color = VDS23_BADGE_TEXT_FARBEN[[badge_key]], bold = TRUE,
|
||||
shading.color = VDS23_BADGE_FARBEN[[badge_key]], font.size = 10
|
||||
)
|
||||
badge_txt = VDS23_STUFEN_TEXTE[as.integer(badge_key) + 1L]
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(zeile$nummer, ". ", zeile$text, " "), fp_normal),
|
||||
ftext(paste0(" ", badge_txt, " "), fp_badge)
|
||||
))
|
||||
if (!is.na(zeile$beispiel)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0("Beispiel: ", zeile$beispiel), fp_beispiel)))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
if (nrow(erg$ohne_faktor) > 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Weitere erhobene Situationen (keinem Faktor zugeordnet)", fp_abschnitt)))
|
||||
for (r in seq_len(nrow(erg$ohne_faktor))) {
|
||||
zeile = erg$ohne_faktor[r, ]
|
||||
badge_key = if (is.na(zeile$wert)) NA_character_ else
|
||||
as.character(max(0L, min(5L, as.integer(zeile$wert))))
|
||||
if (is.na(badge_key)) {
|
||||
fp_badge = fp_text(color = "#555555", bold = TRUE, shading.color = "#E0E0E0", font.size = 10)
|
||||
badge_txt = "k. A."
|
||||
} else {
|
||||
fp_badge = fp_text(
|
||||
color = VDS23_BADGE_TEXT_FARBEN[[badge_key]], bold = TRUE,
|
||||
shading.color = VDS23_BADGE_FARBEN[[badge_key]], font.size = 10
|
||||
)
|
||||
badge_txt = VDS23_STUFEN_TEXTE[as.integer(badge_key) + 1L]
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(zeile$nummer, ". ", zeile$text, " "), fp_normal),
|
||||
ftext(paste0(" ", badge_txt, " "), fp_badge)
|
||||
))
|
||||
if (!is.na(zeile$beispiel)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0("Beispiel: ", zeile$beispiel), fp_beispiel)))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_break(doc)
|
||||
doc = body_add_fpar(doc, fpar(ftext("Top5-Auswahl und Reflexionsfragen", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Qualitative Zusatzinformation, kein Zahlenwert.",
|
||||
fp_text(font.size = 9.5, italic = TRUE, color = "#777777")
|
||||
)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Ausgewählte unangenehmste Situationen", fp_label)))
|
||||
if (nrow(erg$top5) == 0) {
|
||||
doc = body_add_fpar(doc, fpar(ftext("Keine Angabe.", fp_normal)))
|
||||
} else {
|
||||
for (r in seq_len(nrow(erg$top5))) {
|
||||
zeile = erg$top5[r, ]
|
||||
txt = if (!is.na(zeile$nummer)) paste0(zeile$nummer, ". ", zeile$text) else zeile$roh
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0("• ", txt), fp_normal)))
|
||||
}
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
for (rf in erg$reflexionen) {
|
||||
if (is.na(rf$antwort)) next
|
||||
doc = body_add_fpar(doc, fpar(ftext(rf$frage, fp_label)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(rf$antwort, fp_normal)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(VDS23_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)))
|
||||
}
|
||||
})
|
||||
|
||||
ergebnis_r = eventReactive(input$btn_suchen, {
|
||||
|
||||
chiffre = toupper(trimws(input$chiffre))
|
||||
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) {
|
||||
return(list(error = "Bitte Chiffre oder Pseudonym eingeben."))
|
||||
}
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||||
return(list(error = paste0(
|
||||
"Ungültige Chiffre. Erwartet: ein Großbuchstabe + 6 Ziffern (z.B. P000123).")))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(error = paste0(
|
||||
"Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(error = paste0(
|
||||
"Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
|
||||
}
|
||||
|
||||
res_dl = tryCatch(
|
||||
{ source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); list(ok = TRUE) },
|
||||
error = function(e) list(ok = FALSE, msg = e$message)
|
||||
)
|
||||
if (!res_dl$ok) return(list(error = paste0("Fehler im Download-Skript: ", res_dl$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)
|
||||
|
||||
res_ps = tryCatch({
|
||||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||||
pw_treffer = pseudo[pseudo$pseudonym == trimws(input$pseudonym), ]
|
||||
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 (!res_ps$ok) return(list(error = paste0("Fehler im Pseudonym-Skript: ", res_ps$msg)))
|
||||
|
||||
if (!exists("daten_vds23", envir = .GlobalEnv)) {
|
||||
return(list(error = paste0(
|
||||
"Objekt 'daten_vds23' nach dem Sourcen nicht gefunden. Bitte Download-Skript prüfen.")))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||||
return(list(error = paste0(
|
||||
"Objekt 'pseudo' nach dem Sourcen nicht gefunden. Bitte Pseudonym-Skript prüfen.")))
|
||||
}
|
||||
|
||||
daten = get("daten_vds23", envir = .GlobalEnv)
|
||||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
treffer_ps = pseudo_df[pseudo_df$chiffre == chiffre, ]
|
||||
if (nrow(treffer_ps) == 0) {
|
||||
return(list(error = 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(error = paste0(
|
||||
"Kein VDS23-Datensatz für Chiffre '", chiffre, "' gefunden. ",
|
||||
"(", length(alle_session_ids), " Pseudonym(e) geprüft)")))
|
||||
}
|
||||
|
||||
info_mehrere = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
treffer_dat = treffer_dat[order(treffer_dat$created, decreasing = TRUE), ]
|
||||
datum_neu = tryCatch(
|
||||
format(as.POSIXct(treffer_dat$created[1]), "%d.%m.%Y %H:%M"),
|
||||
error = function(e) "unbekanntes Datum"
|
||||
)
|
||||
info_mehrere = paste0(
|
||||
"Mehrere Ausfüllungen gefunden (", n, " Einträge). ",
|
||||
"Angezeigt wird die neueste vom ", datum_neu, "."
|
||||
)
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
datum_str = tryCatch(
|
||||
format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
|
||||
error = function(e) format(Sys.Date(), "%d.%m.%Y")
|
||||
)
|
||||
|
||||
# --- 63 Item-Werte + Beispieltexte ---
|
||||
werte_inhaltlich = integer(63)
|
||||
werte_status = character(63)
|
||||
beispiel_texte = character(63)
|
||||
|
||||
for (i in seq_len(63)) {
|
||||
var = paste0("vds23_", sprintf("%02d", i))
|
||||
var_beispiel = paste0(var, "_beispiel")
|
||||
|
||||
roh = if (var %in% names(zeile)) zeile[[var]][1] else NA
|
||||
lbl_attr = if (var %in% names(daten)) attr(daten[[var]], "labels") else NULL
|
||||
konv = vds23_wert_inhaltlich(roh, lbl_attr)
|
||||
werte_inhaltlich[i] = konv$wert
|
||||
werte_status[i] = konv$status
|
||||
|
||||
beispiel_roh = if (var_beispiel %in% names(zeile)) zeile[[var_beispiel]][1] else NA
|
||||
beispiel_texte[i] = if (!is.na(beispiel_roh) &&
|
||||
trimws(as.character(beispiel_roh)) != "") {
|
||||
trimws(as.character(beispiel_roh))
|
||||
} else {
|
||||
NA_character_
|
||||
}
|
||||
}
|
||||
|
||||
# Debug-Ausgabe je Auswertung, damit die Umrechnung beim ersten echten
|
||||
# Testlauf mit formr-Daten gegengeprueft werden kann (Item 1 als Beispiel).
|
||||
message(
|
||||
"VDS23-DEBUG: Rohwert vds23_01 = '",
|
||||
if ("vds23_01" %in% names(zeile)) as.character(zeile[["vds23_01"]][1]) else "NA",
|
||||
"' -> inhaltlicher Wert = ", werte_inhaltlich[1],
|
||||
" (Status: ", werte_status[1], ")"
|
||||
)
|
||||
|
||||
kodierwarnung = NULL
|
||||
n_unbekannt = sum(werte_status == "unbekannt")
|
||||
if (n_unbekannt > 0) {
|
||||
kodierwarnung = paste0(
|
||||
"Warnung: Die Kodierung konnte für ", n_unbekannt,
|
||||
" Item(s) nicht eindeutig bestimmt werden. Die betroffenen Items ",
|
||||
"werden als 'k. A.' angezeigt statt eines möglicherweise falschen Werts."
|
||||
)
|
||||
}
|
||||
|
||||
faktor_ergebnisse = lapply(names(vds23_faktoren), function(fid) {
|
||||
fak = vds23_faktoren[[fid]]
|
||||
fs = vds23_faktor_score(werte_inhaltlich, fak$items)
|
||||
items_df = data.frame(
|
||||
nummer = fak$items,
|
||||
text = unname(vds23_itemtexte[sprintf("%02d", fak$items)]),
|
||||
wert = werte_inhaltlich[fak$items],
|
||||
beispiel = beispiel_texte[fak$items],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
list(id = fid, name = fak$name, score = fs$score,
|
||||
n_vorhanden = fs$n_vorhanden, n_gesamt = fs$n_gesamt, items = items_df)
|
||||
})
|
||||
|
||||
ohne_faktor = data.frame(
|
||||
nummer = VDS23_OHNE_FAKTOR,
|
||||
text = unname(vds23_itemtexte[sprintf("%02d", VDS23_OHNE_FAKTOR)]),
|
||||
wert = werte_inhaltlich[VDS23_OHNE_FAKTOR],
|
||||
beispiel = beispiel_texte[VDS23_OHNE_FAKTOR],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
top5_roh = if ("vds23_top5_auswahl" %in% names(zeile)) zeile[["vds23_top5_auswahl"]][1] else NA
|
||||
top5 = vds23_parse_top5(top5_roh, vds23_itemtexte)
|
||||
|
||||
reflexion_felder = list(
|
||||
list(spalte = "vds23_reflexion_bezugspersonen_heute",
|
||||
frage = "Heute: häufigste Verhaltensweisen der Bezugspersonen"),
|
||||
list(spalte = "vds23_reflexion_eigene_reaktion",
|
||||
frage = "Eigene Reaktion darauf"),
|
||||
list(spalte = "vds23_reflexion_situationsausgang",
|
||||
frage = "Ausgang der Situationen"),
|
||||
list(spalte = "vds23_reflexion_mutter_kindheit",
|
||||
frage = "Kindheit, Mutter"),
|
||||
list(spalte = "vds23_reflexion_vater_kindheit",
|
||||
frage = "Kindheit, Vater")
|
||||
)
|
||||
reflexionen = lapply(reflexion_felder, function(f) {
|
||||
roh = if (f$spalte %in% names(zeile)) zeile[[f$spalte]][1] else NA
|
||||
antwort = if (!is.na(roh) && trimws(as.character(roh)) != "") {
|
||||
trimws(as.character(roh))
|
||||
} else {
|
||||
NA_character_
|
||||
}
|
||||
list(frage = f$frage, antwort = antwort)
|
||||
})
|
||||
|
||||
list(
|
||||
chiffre = chiffre,
|
||||
ausfuelldatum = datum_str,
|
||||
info_mehrere = info_mehrere,
|
||||
kodierwarnung = kodierwarnung,
|
||||
faktor_ergebnisse = faktor_ergebnisse,
|
||||
ohne_faktor = ohne_faktor,
|
||||
top5 = top5,
|
||||
reflexionen = reflexionen,
|
||||
error = NULL
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) div(class = "alert-fehler", d$error)
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) return(NULL)
|
||||
tagList(
|
||||
if (!is.null(d$info_mehrere)) div(class = "alert-warnung", d$info_mehrere),
|
||||
if (!is.null(d$kodierwarnung)) div(class = "alert-warnung", d$kodierwarnung)
|
||||
)
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!is.null(d$error)) return(NULL)
|
||||
|
||||
faktor_karten = lapply(seq_along(d$faktor_ergebnisse), function(idx) {
|
||||
fe = d$faktor_ergebnisse[[idx]]
|
||||
|
||||
items_ui = lapply(seq_len(nrow(fe$items)), function(r) {
|
||||
zeile = fe$items[r, ]
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(zeile$nummer, ".")),
|
||||
div(class = "item-text-block",
|
||||
div(class = "item-text", zeile$text),
|
||||
if (!is.na(zeile$beispiel))
|
||||
div(class = "item-beispiel", paste0("Beispiel: ", zeile$beispiel))
|
||||
),
|
||||
span(class = paste0("stufe-badge ", vds23_badge_klasse(zeile$wert)),
|
||||
vds23_badge_text(zeile$wert))
|
||||
)
|
||||
})
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", paste0("Faktor ", fe$id, ": ", fe$name)),
|
||||
div(class = "faktor-score-block",
|
||||
div(class = "faktor-score-zahl",
|
||||
if (is.na(fe$score)) "–" else format(round(fe$score, 1), nsmall = 1)),
|
||||
div(class = "faktor-score-label", "Mittelwert auf der Skala 0 bis 5")
|
||||
),
|
||||
if (!is.na(fe$score) && fe$n_vorhanden < fe$n_gesamt)
|
||||
div(class = "faktor-missing-hinweis",
|
||||
paste0("Faktor-Score basiert auf ", fe$n_vorhanden, " von ", fe$n_gesamt, " Items.")),
|
||||
plotOutput(paste0("gauge_", idx), height = "110px"),
|
||||
tags$hr(),
|
||||
div(items_ui)
|
||||
)
|
||||
})
|
||||
|
||||
ohne_faktor_karte = div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Weitere erhobene Situationen (keinem Faktor zugeordnet)"),
|
||||
div(class = "ohne-faktor-hinweis",
|
||||
"Diese Items fließen in keinen Faktor-Score ein."),
|
||||
div(lapply(seq_len(nrow(d$ohne_faktor)), function(r) {
|
||||
zeile = d$ohne_faktor[r, ]
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(zeile$nummer, ".")),
|
||||
div(class = "item-text-block",
|
||||
div(class = "item-text", zeile$text),
|
||||
if (!is.na(zeile$beispiel))
|
||||
div(class = "item-beispiel", paste0("Beispiel: ", zeile$beispiel))
|
||||
),
|
||||
span(class = paste0("stufe-badge ", vds23_badge_klasse(zeile$wert)),
|
||||
vds23_badge_text(zeile$wert))
|
||||
)
|
||||
}))
|
||||
)
|
||||
|
||||
top5_ui = if (nrow(d$top5) == 0) {
|
||||
div(style = "color:#777; font-style:italic;", "Keine Angabe.")
|
||||
} else {
|
||||
tags$ul(class = "top5-liste",
|
||||
lapply(seq_len(nrow(d$top5)), function(r) {
|
||||
zeile = d$top5[r, ]
|
||||
txt = if (!is.na(zeile$nummer)) paste0(zeile$nummer, ". ", zeile$text) else zeile$roh
|
||||
tags$li(class = "top5-eintrag", txt)
|
||||
})
|
||||
)
|
||||
}
|
||||
|
||||
reflexionen_vorhanden = Filter(function(rf) !is.na(rf$antwort), d$reflexionen)
|
||||
reflexionen_ui = if (length(reflexionen_vorhanden) == 0) {
|
||||
div(style = "color:#777; font-style:italic;", "Keine Angaben zu den Reflexionsfragen vorhanden.")
|
||||
} else {
|
||||
lapply(reflexionen_vorhanden, function(rf) {
|
||||
div(class = "freitext-block",
|
||||
div(class = "freitext-frage", rf$frage),
|
||||
div(class = "freitext-antwort", rf$antwort)
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
qualitativ_karte = div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Top5-Auswahl und Reflexionsfragen"),
|
||||
div(class = "qualitativ-hinweis",
|
||||
"Qualitative Zusatzinformation, kein Zahlenwert."),
|
||||
tags$h5("Ausgewählte unangenehmste Situationen"),
|
||||
top5_ui,
|
||||
tags$hr(),
|
||||
reflexionen_ui
|
||||
)
|
||||
|
||||
tagList(
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), d$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfülldatum: "), d$ausfuelldatum
|
||||
)
|
||||
),
|
||||
faktor_karten,
|
||||
ohne_faktor_karte,
|
||||
qualitativ_karte,
|
||||
div(class = "disclaimer-zeile", VDS23_DISCLAIMER)
|
||||
)
|
||||
})
|
||||
|
||||
lapply(1:6, function(idx) {
|
||||
output[[paste0("gauge_", idx)]] = renderPlot({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
req(is.null(d$error))
|
||||
fe = d$faktor_ergebnisse[[idx]]
|
||||
if (is.na(fe$score)) return(NULL)
|
||||
vds23_achse_plot(fe$score)
|
||||
}, bg = "transparent")
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
chiffre_esc = if (is.list(d) && is.null(d$error) && nchar(d$chiffre) > 0)
|
||||
gsub("[^A-Za-z0-9_-]", "_", d$chiffre) else "export"
|
||||
ausfuelldatum_fn = if (is.list(d) && is.null(d$error) && !is.null(d$ausfuelldatum)) {
|
||||
tryCatch(
|
||||
format(as.Date(d$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d"),
|
||||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||||
)
|
||||
} else {
|
||||
format(Sys.Date(), "%Y%m%d")
|
||||
}
|
||||
paste0("VDS23_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
daten_ok = is.list(d) && is.null(d$error)
|
||||
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_vds23_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)
|
||||
2879
VDS23/renv.lock
Normal file
2879
VDS23/renv.lock
Normal file
File diff suppressed because it is too large
Load diff
17
VDS23/setup_renv.R
Normal file
17
VDS23/setup_renv.R
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
# Einmalig ausfuehren, bevor die App zum ersten Mal gestartet wird.
|
||||
# Initialisiert renv und installiert alle benoetigten Pakete.
|
||||
#
|
||||
# formr wird hier installiert, weil das extern gesourcte Download-Skript
|
||||
# (get_data_vds23.R) es benoetigt - die App selbst laedt formr nicht per
|
||||
# library() und spricht nie direkt mit der formr-API.
|
||||
# DBI und RSQLite werden vom gesourcten Pseudonym-Skript benoetigt,
|
||||
# nicht direkt von der App selbst.
|
||||
|
||||
renv::init()
|
||||
|
||||
pkgs = c("shiny", "dplyr", "ggplot2", "haven", "officer", "DBI", "RSQLite", "formr")
|
||||
install.packages(pkgs)
|
||||
|
||||
renv::snapshot()
|
||||
|
||||
message("Setup abgeschlossen. App starten mit: shiny::runApp()")
|
||||
Loading…
Add table
Add a link
Reference in a new issue