973 lines
42 KiB
R
973 lines
42 KiB
R
# Präambel ####
|
||
|
||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_vds31.R" # liefert: daten_vds31
|
||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert: pseudo
|
||
AKZENT_FARBE = "#8B2635"
|
||
|
||
VDS31_DISCLAIMER = paste0(
|
||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
|
||
"Die sechs Stufenprofile sind ipsativ zu interpretieren, es liegt kein Normvergleich vor."
|
||
)
|
||
VDS31_DISCLAIMER = gsub("fuer", "für", VDS31_DISCLAIMER, fixed = TRUE)
|
||
|
||
VDS31_IPSATIV_HINWEIS = paste0(
|
||
"Es gibt keinen klinischen Cutoff und keine Normtabelle fuer den VDS31. Die sechs ",
|
||
"Stufenprofile sind rein ipsativ zu interpretieren (im Vergleich der Stufen zueinander ",
|
||
"innerhalb derselben Person), nicht gegen eine externe Norm."
|
||
)
|
||
VDS31_IPSATIV_HINWEIS = gsub("fuer", "für", VDS31_IPSATIV_HINWEIS, fixed = TRUE)
|
||
|
||
# Anker-Texte der 6 Antwortstufen, woertlich wie im formr-Choice-Text
|
||
# (Abschnitt 1.1). Nur fuer die Anzeige des Badge-Labels - die Extraktion
|
||
# des Rohwerts selbst passiert unabhaengig davon in extrahiere_stufe().
|
||
VDS31_ANKER_TEXTE = c("0 = nicht", "1 = kaum", "2 = etwas", "3 = deutlich", "4 = sehr", "5 = extrem")
|
||
|
||
# Badge-Farben fuer die 6 Antwortstufen, an die Referenzimplementierung
|
||
# pg13r/app.R angelehnt (dort PG13R_BADGE_FARBEN, gruen -> dunkelrot mit 5
|
||
# Stufen): die 5 pg13r-Farben werden 1:1 uebernommen (Stufe 0, 1, 3, 4, 5
|
||
# hier), dazwischen ein zusaetzlicher Zwischenton (Stufe 2) fuer den
|
||
# sechsten Schritt ergaenzt. Zeigt nur die Antwortintensitaet des
|
||
# einzelnen Items, keine klinische Bewertung (kein Unterschied zwischen
|
||
# Ressourcen- und Defizit-Items - siehe Abschnitt 9 der Spezifikation).
|
||
VDS31_BADGE_FARBEN = c(
|
||
"0" = "#4CAF50",
|
||
"1" = "#F48FB1",
|
||
"2" = "#F06292",
|
||
"3" = "#EF5350",
|
||
"4" = "#B71C1C",
|
||
"5" = "#4A0000"
|
||
)
|
||
VDS31_BADGE_TEXT_FARBEN = c(
|
||
"0" = "white",
|
||
"1" = "#333333",
|
||
"2" = "white",
|
||
"3" = "white",
|
||
"4" = "white",
|
||
"5" = "white"
|
||
)
|
||
|
||
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 ####
|
||
|
||
# Extraktion des Item-Rohwerts (0-5) aus einer formr-'mc'-Spalte. Das
|
||
# tatsaechliche Exportformat dieses Feldtyps ist NICHT verifiziert (anders
|
||
# als bei mc_button) - daher defensiv mit klarer Prioritaetsreihenfolge und
|
||
# hartem Fehler statt stiller Annahme, falls keiner der drei Faelle zutrifft.
|
||
# Vor dem ersten echten Testlauf gegen die Produktivdaten pruefen, welcher
|
||
# der drei Faelle tatsaechlich zutrifft (Abschnitt 4 der Spezifikation).
|
||
extrahiere_stufe = function(spalte, wert) {
|
||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(NA_real_)
|
||
w = wert[1]
|
||
|
||
# Fall A: haven_labelled mit labels-Attribut -> Label-Text des Werts nehmen,
|
||
# dann fuehrende Ziffer per Regex aus dem Label-Text extrahieren.
|
||
lab = attr(spalte, "labels")
|
||
if (!is.null(lab) && length(lab) > 0) {
|
||
pos = which(as.vector(lab) == suppressWarnings(as.numeric(w)))
|
||
if (length(pos) > 0) {
|
||
label_text = names(lab)[pos[1]]
|
||
if (!is.null(label_text) && grepl("^\\s*[0-5]\\s*=", label_text)) {
|
||
return(as.numeric(sub("^\\s*([0-5])\\s*=.*$", "\\1", label_text)))
|
||
}
|
||
}
|
||
}
|
||
|
||
# Fall B: Text/Faktor direkt im Format "3 = deutlich" -> Regex auf den Text
|
||
# selbst, nie auf die Position im Vektor.
|
||
w_text = trimws(as.character(w))
|
||
if (grepl("^\\s*[0-5]\\s*=", w_text)) {
|
||
return(as.numeric(sub("^\\s*([0-5])\\s*=.*$", "\\1", w_text)))
|
||
}
|
||
|
||
# Fall C: bereits numerisch 0-5.
|
||
w_num = suppressWarnings(as.numeric(w))
|
||
if (!is.na(w_num) && w_num >= 0 && w_num <= 5 && w_num == round(w_num)) {
|
||
return(w_num)
|
||
}
|
||
|
||
stop(
|
||
"extrahiere_stufe: Wert '", w_text, "' konnte keinem der drei bekannten Faelle ",
|
||
"(haven_labelled mit passendem Label-Text, Text/Faktor '0-5 = ...', numerisch 0-5) ",
|
||
"zugeordnet werden. Bitte Exportformat des formr-Feldtyps 'mc' pruefen."
|
||
)
|
||
}
|
||
|
||
# Anker-Text zum Rohwert (0-5) fuer die Badge-Beschriftung, NA -> "keine
|
||
# Angabe" statt eines leeren/falschen Labels.
|
||
vds31_anker_text = function(wert) {
|
||
if (is.null(wert) || is.na(wert) || wert < 0 || wert > 5) return("keine Angabe")
|
||
VDS31_ANKER_TEXTE[as.integer(round(wert)) + 1L]
|
||
}
|
||
|
||
# Badge-Style aus VDS31_BADGE_FARBEN/-_TEXT_FARBEN (Praeambel, an
|
||
# pg13r/app.R angelehnt). Fehlender Wert (NA) bekommt bewusst ein
|
||
# neutrales Grau statt einer der sechs Farben.
|
||
vds31_badge_style = function(wert) {
|
||
if (is.null(wert) || is.na(wert) || wert < 0 || wert > 5) {
|
||
return("background-color:#E0E0E0; color:#555555;")
|
||
}
|
||
k = as.character(as.integer(round(wert)))
|
||
paste0("background-color:", VDS31_BADGE_FARBEN[[k]], "; color:", VDS31_BADGE_TEXT_FARBEN[[k]], ";")
|
||
}
|
||
|
||
# Vier-Tendenzen-Klassifikation (eigene Konvention, siehe Abschnitt 1.4 der
|
||
# Spezifikation). Schwelle 2,5 = Skalenmitte 0-5. Fuer Stufen ohne M-Items
|
||
# (nur Ue) wird nur die Ressourcen-Achse gewertet.
|
||
vds31_vier_tendenzen = function(ressourcen_mw, defizit_mw, hat_defizit) {
|
||
ress_hoch = !is.na(ressourcen_mw) && ressourcen_mw >= 2.5
|
||
|
||
if (!hat_defizit) {
|
||
if (ress_hoch) {
|
||
return(list(text = "Ressourcen hoch", klasse = "ress_hoch"))
|
||
}
|
||
return(list(text = "Ressourcen niedrig", klasse = "ress_niedrig"))
|
||
}
|
||
|
||
defizit_hoch = !is.na(defizit_mw) && defizit_mw >= 2.5
|
||
|
||
if (!ress_hoch && !defizit_hoch) {
|
||
return(list(text = "Weder Ressourcen noch Defizite in nennenswertem Umfang", klasse = "weder"))
|
||
}
|
||
if (!ress_hoch && defizit_hoch) {
|
||
return(list(text = "(Fast) nur Defizite", klasse = "nur_defizite"))
|
||
}
|
||
if (ress_hoch && !defizit_hoch) {
|
||
return(list(text = "(Fast) nur Ressourcen", klasse = "nur_ressourcen"))
|
||
}
|
||
list(text = "Sowohl Ressourcen als auch Defizite", klasse = "beides")
|
||
}
|
||
|
||
# Item-Detail (Feldname, Text, Rohwert) je Gruppe fuer die Einzelitem-
|
||
# Anzeige in UI und Word-Export, getrennt nach Ressourcen(P)/Defizit(M).
|
||
vds31_item_detail = function(felder, werte, item_texte) {
|
||
data.frame(
|
||
feldname = felder,
|
||
text = unname(item_texte[felder]),
|
||
wert = unname(werte[felder]),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
}
|
||
|
||
# Generische Auswertung je Stufe aus der item_tabelle (Abschnitt 1.3), statt
|
||
# denselben Berechnungscode 6x zu duplizieren. 'werte' ist ein benannter
|
||
# numerischer Vektor (Name = Feldname, Wert = Rohwert 0-5 oder NA).
|
||
# 'item_texte' ist ein benannter Textvektor (Name = Feldname) fuer die
|
||
# Einzelitem-Anzeige (aus der vds31.xlsx uebernommen, siehe Datenaufbereitung).
|
||
berechne_stufen_ergebnisse = function(item_tabelle, werte, item_texte) {
|
||
lapply(VDS31_STUFEN_ORDER, function(s) {
|
||
zeilen = item_tabelle[item_tabelle$stufe == s, ]
|
||
p_felder = zeilen$feldname[zeilen$pm == "P"]
|
||
m_felder = zeilen$feldname[zeilen$pm == "M"]
|
||
hat_defizit = length(m_felder) > 0
|
||
|
||
p_werte = werte[p_felder]
|
||
m_werte = if (hat_defizit) werte[m_felder] else numeric(0)
|
||
|
||
p_items = vds31_item_detail(p_felder, werte, item_texte)
|
||
m_items = if (hat_defizit) vds31_item_detail(m_felder, werte, item_texte) else
|
||
data.frame(feldname = character(0), text = character(0), wert = numeric(0), stringsAsFactors = FALSE)
|
||
|
||
# Alle Items sind formr-Pflichtfelder, im Normalfall also vollstaendig.
|
||
# Trotzdem defensiv: fehlt ein Item-Wert, wird die Stufe als
|
||
# unvollstaendig markiert statt mit na.rm = TRUE eine verzerrte
|
||
# Teilsumme auszugeben (Abschnitt 1.3).
|
||
unvollstaendig = any(is.na(p_werte)) || (hat_defizit && any(is.na(m_werte)))
|
||
|
||
if (unvollstaendig) {
|
||
return(list(
|
||
stufe = s, name = VDS31_STUFEN_NAMEN[[s]], hat_defizit = hat_defizit,
|
||
n_p = length(p_felder), n_m = length(m_felder),
|
||
unvollstaendig = TRUE,
|
||
summe = NA_real_, ressourcen_summe = NA_real_, ressourcen_mw = NA_real_,
|
||
defizit_summe = NA_real_, defizit_mw = NA_real_, stufengesamtwert = NA_real_,
|
||
pluspunkte = NA_integer_, minuspunkte = NA_integer_,
|
||
kategorie = list(text = "nicht auswertbar", klasse = "unvollstaendig"),
|
||
p_items = p_items, m_items = m_items
|
||
))
|
||
}
|
||
|
||
ressourcen_summe = sum(p_werte)
|
||
ressourcen_mw = ressourcen_summe / length(p_felder)
|
||
|
||
if (hat_defizit) {
|
||
defizit_summe = sum(m_werte)
|
||
defizit_mw = defizit_summe / length(m_felder)
|
||
stufengesamtwert = ressourcen_mw + defizit_mw
|
||
minuspunkte = sum(m_werte >= 3)
|
||
} else {
|
||
# Sonderfall Ue: 0 M-Items, Defizit_MW nicht definiert (keine Division
|
||
# durch 0), Stufengesamtwert = Ressourcen_MW allein (Abschnitt 1.3).
|
||
defizit_summe = NA_real_
|
||
defizit_mw = NA_real_
|
||
stufengesamtwert = ressourcen_mw
|
||
minuspunkte = 0L
|
||
}
|
||
|
||
list(
|
||
stufe = s, name = VDS31_STUFEN_NAMEN[[s]], hat_defizit = hat_defizit,
|
||
n_p = length(p_felder), n_m = length(m_felder),
|
||
unvollstaendig = FALSE,
|
||
summe = ressourcen_summe + (if (hat_defizit) defizit_summe else 0),
|
||
ressourcen_summe = ressourcen_summe, ressourcen_mw = ressourcen_mw,
|
||
defizit_summe = defizit_summe, defizit_mw = defizit_mw,
|
||
stufengesamtwert = stufengesamtwert,
|
||
pluspunkte = sum(p_werte >= 3),
|
||
minuspunkte = minuspunkte,
|
||
kategorie = vds31_vier_tendenzen(ressourcen_mw, defizit_mw, hat_defizit),
|
||
p_items = p_items, m_items = m_items
|
||
)
|
||
})
|
||
}
|
||
|
||
# Profildiagramm: horizontales gruppiertes Balkendiagramm, eine Zeile je
|
||
# Stufe (E oben, Ue unten), zwei Balken (Ressourcen_MW / Defizit_MW),
|
||
# Skala 0-5 mit gestrichelter Referenzlinie bei 2,5 (Skalenmitte). Kein
|
||
# Gauge-Muster, da VDS31 kein Summenscore, sondern ein 6-Stufen-Profil ist.
|
||
make_vds31_profil_plot = function(stufen_ergebnisse) {
|
||
zeilen = list()
|
||
for (s in stufen_ergebnisse) {
|
||
zeilen[[length(zeilen) + 1]] = data.frame(
|
||
stufe = s$name, typ = "Ressourcen",
|
||
wert = s$ressourcen_mw, unvollstaendig = isTRUE(s$unvollstaendig),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
if (isTRUE(s$hat_defizit)) {
|
||
zeilen[[length(zeilen) + 1]] = data.frame(
|
||
stufe = s$name, typ = "Defizit",
|
||
wert = s$defizit_mw, unvollstaendig = isTRUE(s$unvollstaendig),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
}
|
||
}
|
||
df = do.call(rbind, zeilen)
|
||
df$stufe = factor(df$stufe, levels = rev(unique(df$stufe)))
|
||
df$typ = factor(df$typ, levels = c("Ressourcen", "Defizit"))
|
||
df$balken = ifelse(is.na(df$wert), 0, df$wert)
|
||
|
||
ggplot(df, aes(x = stufe, y = balken, fill = typ)) +
|
||
geom_col(position = position_dodge(width = 0.7), width = 0.6) +
|
||
geom_text(
|
||
data = subset(df, !unvollstaendig),
|
||
aes(label = sprintf("%.2f", wert)),
|
||
position = position_dodge(width = 0.7), hjust = -0.25, size = 3.2, color = "#333333"
|
||
) +
|
||
geom_text(
|
||
data = subset(df, unvollstaendig),
|
||
aes(y = 0.1, label = "unvollständig"),
|
||
position = position_dodge(width = 0.7), hjust = 0, size = 2.8,
|
||
fontface = "italic", color = "#888888"
|
||
) +
|
||
geom_hline(yintercept = 2.5, linetype = "dashed", color = "#999999", linewidth = 0.6) +
|
||
scale_fill_manual(values = c("Ressourcen" = "#4A7C59", "Defizit" = AKZENT_FARBE)) +
|
||
coord_flip(clip = "off") +
|
||
scale_y_continuous(limits = c(0, 5.7), breaks = 0:5) +
|
||
theme_minimal(base_size = 12) +
|
||
theme(
|
||
axis.title = element_blank(),
|
||
legend.title = element_blank(),
|
||
legend.position = "top",
|
||
panel.grid.major.y = element_blank(),
|
||
panel.grid.minor = element_blank(),
|
||
plot.margin = margin(t = 5, r = 40, b = 5, l = 5)
|
||
)
|
||
}
|
||
|
||
|
||
# Datenaufbereitung ####
|
||
|
||
# Statische Item-Stufe-Zuordnung (Abschnitt 1.2 der Spezifikation). Je Stufe
|
||
# wird ueber 1:n durchnummeriert; 'p' enthaelt die Itemnummern der
|
||
# Ressourcen-(P-)Items, alle uebrigen Nummern der Stufe sind Defizit-(M-)Items.
|
||
# Anzeigereihenfolge immer E -> I -> S -> Z -> In -> Ue.
|
||
VDS31_STUFEN_DEF = list(
|
||
list(code = "E", praefix = "vds31_e", n = 12, p = c(1, 2, 3, 6, 12)),
|
||
list(code = "I", praefix = "vds31_i", n = 11, p = c(3, 6, 7, 11)),
|
||
list(code = "S", praefix = "vds31_s", n = 11, p = c(1, 2, 3, 4, 9, 11)),
|
||
list(code = "Z", praefix = "vds31_z", n = 11, p = c(1, 2, 5, 7, 8, 10)),
|
||
list(code = "In", praefix = "vds31_in", n = 10, p = c(1, 2, 3)),
|
||
list(code = "Ue", praefix = "vds31_ue", n = 11, p = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11))
|
||
)
|
||
|
||
VDS31_STUFEN_ORDER = sapply(VDS31_STUFEN_DEF, function(d) d$code)
|
||
|
||
VDS31_STUFEN_NAMEN = c(
|
||
E = "E – einverleibend",
|
||
I = "I – impulsiv",
|
||
S = "S – souverän",
|
||
Z = "Z – zwischenmenschlich",
|
||
In = "In – institutionell",
|
||
Ue = "Ü – überindividuell"
|
||
)
|
||
|
||
item_tabelle = do.call(rbind, lapply(VDS31_STUFEN_DEF, function(def) {
|
||
nummern = seq_len(def$n)
|
||
data.frame(
|
||
feldname = paste0(def$praefix, sprintf("%02d", nummern)),
|
||
stufe = def$code,
|
||
pm = ifelse(nummern %in% def$p, "P", "M"),
|
||
stringsAsFactors = FALSE
|
||
)
|
||
}))
|
||
|
||
# Kontrollsumme: 12+11+11+11+10+11 = 66 (Abschnitt 1.2), generisch geprueft
|
||
# statt 6x denselben Vergleich hinzuschreiben.
|
||
VDS31_ERWARTETE_ANZAHL = c(E = 12, I = 11, S = 11, Z = 11, In = 10, Ue = 11)
|
||
.vds31_tats_anzahl = table(item_tabelle$stufe)[names(VDS31_ERWARTETE_ANZAHL)]
|
||
if (nrow(item_tabelle) != 66 || !identical(as.integer(.vds31_tats_anzahl), as.integer(VDS31_ERWARTETE_ANZAHL))) {
|
||
stop(
|
||
"VDS31: Kontrollsumme der Item-Stufe-Zuordnung stimmt nicht (", nrow(item_tabelle),
|
||
" Items insgesamt, erwartet 66). Bitte 'VDS31_STUFEN_DEF' pruefen (Copy-Paste-Fehler?)."
|
||
)
|
||
}
|
||
|
||
# Item-Wortlaut 1:1 aus der label-Spalte der vds31.xlsx (Sheet 'survey')
|
||
# uebernommen - dort frei von Markdown-/Piping-Resten (die einzigen "##"
|
||
# im Sheet stehen in den Stufen-Ueberschriftszeilen, nicht in den 66
|
||
# Item-Zeilen selbst, geprueft beim Einpflegen). Hartkodiert statt aus dem
|
||
# labels-/label-Attribut von 'daten_vds31' gelesen, weil dessen genaues
|
||
# Exportformat fuer den Feldtyp 'mc' nicht verifiziert ist (Abschnitt 1.1).
|
||
VDS31_ITEM_TEXTE = c(
|
||
vds31_e01 = "Beschenkt zu werden macht mir große Freude.",
|
||
vds31_e02 = "Ich liebe es, verwöhnt zu werden.",
|
||
vds31_e03 = "Ich mag Genüsse, für die ich mich nicht anstrengen muss.",
|
||
vds31_e04 = "Ich neige eher zum Annehmen, Empfangen, als zum Zupacken.",
|
||
vds31_e05 = "Ich neige eher zum Zuhören, Betrachten, Auskosten als zum Aktiven.",
|
||
vds31_e06 = "Es ist schön, jemand zu haben, der spürt, was ich brauche.",
|
||
vds31_e07 = "Ich bin darauf angewiesen, dass andere mir geben, was ich brauche. Ich kann es mir nicht selbst nehmen.",
|
||
vds31_e08 = "Ich brauche, dass mir gegeben wird, was ich brauche.",
|
||
vds31_e09 = "Ich fürchte, nicht zu erhalten, was ich brauche.",
|
||
vds31_e10 = "Ich fürchte, dass zu viel Schädliches an mich herankommt.",
|
||
vds31_e11 = "Ich fürchte, dass ich zu gierig von dem anderen in mich aufnehme.",
|
||
vds31_e12 = "Ich kann annehmen, mich öffnen, mich verschließen.",
|
||
|
||
vds31_i01 = "Einen Wunsch erfülle ich mir am liebsten gleich.",
|
||
vds31_i02 = "Wenn ich etwas will, muss ich es mir gleich besorgen.",
|
||
vds31_i03 = "Mit einem Bedürfnis wende ich mich spontan an meine Bezugsperson.",
|
||
vds31_i04 = "Wird mein Bedürfnis nicht befriedigt, reagiere ich ärgerlich oder beleidigt.",
|
||
vds31_i05 = "Meine Bezugspersonen haben die gleichen Interessen wie ich.",
|
||
vds31_i06 = "Ich habe ein reiches Gefühlsleben, meine Gefühle zeige ich spontan.",
|
||
vds31_i07 = "Ich kann meine Gefühle gut zeigen, auch mal intensiv z.B. Wut oder Freude.",
|
||
vds31_i08 = "Trennung von meiner Bezugsperson wäre das Schrecklichste, allein sein kann ich nicht.",
|
||
vds31_i09 = "Ich kann nicht warten.",
|
||
vds31_i10 = "Ich brauche einen Menschen, der dann, wenn ich es mir holen will, mir das abgeben will, was ich brauche.",
|
||
vds31_i11 = "Ich brauche nicht warten, bis mir etwas angeboten wird.",
|
||
|
||
vds31_s01 = "Ich kann etwas bewirken.",
|
||
vds31_s02 = "Ich kenne die Auswirkungen meines Handelns.",
|
||
vds31_s03 = "Ich achte bewusst auf die Wirkungen meines Handelns.",
|
||
vds31_s04 = "Auch wenn ich am liebsten sofort meinen Ärger zeigen und losschimpfen möchte, kann ich mich bremsen, falls dies günstiger für mich ist.",
|
||
vds31_s05 = "Ich brauche im Umgang mit anderen das Gefühl, die Situation im Griff zu haben.",
|
||
vds31_s06 = "Es alarmiert mich, wenn andere die Situation gestalten und ich nicht weiß, worauf sie hinauswollen.",
|
||
vds31_s07 = "Ich achte darauf, dass ich nicht zu kurz komme.",
|
||
vds31_s08 = "Ich verhalte mich so, dass andere mir das geben, was ich will.",
|
||
vds31_s09 = "Was ich tue, möchte ich auf meine Weise machen, ich lasse mich nicht gerne führen und leiten.",
|
||
vds31_s10 = "Ich glaube, dass Menschen eigennützig sind und Einfluss haben wollen.",
|
||
vds31_s11 = "Ich kann auf andere Menschen so einwirken, dass sie in meinem Sinne handeln.",
|
||
|
||
vds31_z01 = "Gutes Einvernehmen und Harmonie ist mir wichtig.",
|
||
vds31_z02 = "Anderen eine Freude machen, ist mir wichtig.",
|
||
vds31_z03 = "Leistungen erbringe ich weniger für mich als für die mir wichtigen Menschen.",
|
||
vds31_z04 = "Richtig wohl fühle ich mich nur, wenn ich bei den mir wichtigen Menschen bin.",
|
||
vds31_z05 = "Ich tue viel, um eine gute Beziehung zu pflegen.",
|
||
vds31_z06 = "Ich kann leicht auf Eigenes verzichten, Beziehung und Gemeinsamkeit geben mir mehr.",
|
||
vds31_z07 = "Ich empfinde große Liebe zu meiner Bezugsperson (Partner, Eltern, Kinder).",
|
||
vds31_z08 = "Mein Handeln diesem Menschen gegenüber entsteht ganz aus dieser Liebe und Verbundenheit heraus.",
|
||
vds31_z09 = "Ich brauche das Gefühl, angenommen und gemocht zu werden.",
|
||
vds31_z10 = "Ich kann mich gut in andere Menschen hineinversetzen, sie gut verstehen.",
|
||
vds31_z11 = "Ich brauche eine gefühlvoll liebende Beziehung und Harmonie in der Beziehung.",
|
||
|
||
vds31_in01 = "Auch wenn mir ein Mensch sehr wichtig ist, erwarte ich von ihm, dass er sich an unsere eingespielten Umgangsregeln hält.",
|
||
vds31_in02 = "Wenn ich eindeutig im Recht bin, gebe ich nicht nach, auch wenn der andere ärgerlich auf mich ist.",
|
||
vds31_in03 = "Ich kann es meiner Bezugsperson nicht immer recht machen, auch wenn die Beziehung zeitweise darunter leidet.",
|
||
vds31_in04 = "Ich ziehe einen vernünftigen Umgang mit Menschen dem emotionalen vor.",
|
||
vds31_in05 = "Intensive Gefühle machen eine Beziehung nur komplizierter.",
|
||
vds31_in06 = "Auch der Mensch, den ich sehr mag, hat genügend Seiten, die mir missfallen.",
|
||
vds31_in07 = "Wenn es nicht gelingt, Konflikte durch vernünftige Abmachungen zu bannen, reagiere ich eher hilflos.",
|
||
vds31_in08 = "Ein reibungsloses Zusammenleben erfordert das Einhalten von Umgangsregeln, auch wenn sie mal in einer einzelnen Situation zu einer Ungerechtigkeit oder Benachteiligung eines Menschen führen.",
|
||
vds31_in09 = "Ich brauche klare Umgangsregeln, dass ich mich darauf verlassen kann, dass andere sich an diese Regeln halten.",
|
||
vds31_in10 = "Ich fürchte, die Übersicht über die vernünftige Regelung von Beziehungen zu verlieren.",
|
||
|
||
vds31_ue01 = "Mir sind Umgangsregeln zwar wichtig, aber ich folge ihnen nicht um jeden Preis.",
|
||
vds31_ue02 = "Auch wenn ich mich dadurch außerhalb einer Gemeinschaft oder Gruppe stelle, verlasse ich mich auf mein Gefühl von Gerechtigkeit.",
|
||
vds31_ue03 = "Ich erlebe mich als selbständig und unabhängig und kann aus diesem Selbstgefühl heraus recht gute Beziehungen gestalten.",
|
||
vds31_ue04 = "Ich kann sowohl mein Eigenleben führen als auch eine gefühlvolle Beziehung leben.",
|
||
vds31_ue05 = "Ich lebe nicht durch Beziehung, sondern ich lebe mein Leben und ich habe auch Beziehungen.",
|
||
vds31_ue06 = "Wenn es um mehr Menschlichkeit geht, verletze ich bewusst die Umgangsregeln der Gemeinschaft, der ich zugehöre.",
|
||
vds31_ue07 = "Ich bleibe nicht in einer Beziehung, weil ich sie oder meine Bezugsperson brauche.",
|
||
vds31_ue08 = "Ich muss nicht aufmerksam die Einhaltung von Regeln und korrektem Umgang miteinander verfolgen. Da kann ich mich auf mein Gefühl und meine Wehrhaftigkeit verlassen.",
|
||
vds31_ue09 = "Ich brauche nicht eine äußere Regelung zur Pflege des zwischenmenschlichen Umgangs.",
|
||
vds31_ue10 = "Ich kann Umgangsregeln kritisch handhaben.",
|
||
vds31_ue11 = "Ich kann nicht auf Dauer ohne andere Menschen sein, ohne eine gesunde Natur und Ökologie leben."
|
||
)
|
||
|
||
# Defensiver Abgleich: jedes Feld aus item_tabelle muss einen Text haben und
|
||
# umgekehrt - schuetzt vor Tippfehlern beim Uebertragen aus der xlsx.
|
||
.vds31_fehlende_texte = setdiff(item_tabelle$feldname, names(VDS31_ITEM_TEXTE))
|
||
.vds31_ueberzaehlige_texte = setdiff(names(VDS31_ITEM_TEXTE), item_tabelle$feldname)
|
||
if (length(.vds31_fehlende_texte) > 0 || length(.vds31_ueberzaehlige_texte) > 0) {
|
||
stop(
|
||
"VDS31: 'VDS31_ITEM_TEXTE' stimmt nicht mit 'item_tabelle' ueberein. ",
|
||
"Fehlend: ", paste(.vds31_fehlende_texte, collapse = ", "), ". ",
|
||
"Ueberzaehlig: ", paste(.vds31_ueberzaehlige_texte, collapse = ", "), "."
|
||
)
|
||
}
|
||
|
||
|
||
# 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; }
|
||
.ipsativ-hinweis {
|
||
background: #F5F5F5; border-left: 5px solid #9E9E9E;
|
||
padding: 10px 16px; border-radius: 4px; color: #555555;
|
||
margin-bottom: 16px; font-size: 0.88em; font-style: italic;
|
||
}
|
||
.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: 22px; 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-untertitel {
|
||
color: #8B2635; font-size: 1.0rem; font-weight: 700;
|
||
margin: 22px 0 10px;
|
||
}
|
||
.stufe-untertitel:first-child { margin-top: 0; }
|
||
.item-gruppen-wrap { display: flex; gap: 28px; flex-wrap: wrap; margin-bottom: 8px; }
|
||
.item-gruppe { flex: 1; min-width: 280px; }
|
||
.item-gruppe-titel {
|
||
font-weight: 700; color: #777; font-size: 0.78em; text-transform: uppercase;
|
||
letter-spacing: 0.04em; margin-bottom: 4px;
|
||
}
|
||
.item-gruppe-leer { color: #999; font-style: italic; font-size: 0.88em; padding: 6px 0; }
|
||
.stufen-zeile {
|
||
display: flex; align-items: center; gap: 16px; flex-wrap: wrap;
|
||
padding: 10px 0; border-bottom: 1px solid #F0F0F0;
|
||
}
|
||
.stufen-zeile:last-child { border-bottom: none; }
|
||
.stufen-name { font-weight: 700; color: #333; min-width: 220px; }
|
||
.stufen-wert { color: #8B2635; font-weight: 700; min-width: 190px; }
|
||
.punkte-text { color: #666; font-size: 0.88em; margin-left: auto; }
|
||
.tendenz-badge {
|
||
border-radius: 4px; padding: 3px 10px; font-weight: 700;
|
||
font-size: 0.82em; white-space: nowrap; display: inline-block;
|
||
}
|
||
.tendenz-weder { background: #F5F5F5; color: #616161; }
|
||
.tendenz-nur_defizite { background: #FFEBEE; color: #B71C1C; }
|
||
.tendenz-nur_ressourcen { background: #E8F5E9; color: #2E7D32; }
|
||
.tendenz-beides { background: #FFF3E0; color: #E65100; }
|
||
.tendenz-ress_hoch { background: #E8F5E9; color: #2E7D32; }
|
||
.tendenz-ress_niedrig { background: #F5F5F5; color: #616161; }
|
||
.tendenz-unvollstaendig { background: #ECEFF1; color: #546E7A; }
|
||
.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("VDS31 – Entwicklungsfragebogen"),
|
||
tags$p("Verhaltensdiagnostiksystem nach Prof. Dr. Dr. Serge Sulz – 66 Items auf 6 Entwicklungsstufen")
|
||
),
|
||
|
||
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_vds31_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_hinweis = fp_text(font.size = 9.5, italic = TRUE, color = "#666666")
|
||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("VDS31 – Entwicklungsfragebogen", fp_titel)))
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext("Chiffre: ", fp_label),
|
||
ftext(erg$chiffre, fp_normal),
|
||
ftext(" Ausfülldatum: ", fp_label),
|
||
ftext(format(erg$ausfuelldatum, "%d.%m.%Y"), fp_normal)
|
||
))
|
||
if (!is.null(erg$mehrfach_warnung)) {
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(erg$mehrfach_warnung, fp_text(font.size = 10, italic = TRUE, color = "#555555"))
|
||
))
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext(VDS31_IPSATIV_HINWEIS, fp_hinweis)))
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext("Stufenprofil", fp_abschnitt)))
|
||
|
||
profil_df = data.frame(
|
||
Stufe = sapply(erg$stufen_ergebnisse, function(s) s$name),
|
||
"Summe" = sapply(erg$stufen_ergebnisse, function(s)
|
||
if (isTRUE(s$unvollstaendig)) "unvollständig" else sprintf("%.0f", s$summe)),
|
||
"Ressourcen (MW)" = sapply(erg$stufen_ergebnisse, function(s)
|
||
if (isTRUE(s$unvollstaendig)) "–" else sprintf("%.2f", s$ressourcen_mw)),
|
||
"Defizit (MW)" = sapply(erg$stufen_ergebnisse, function(s)
|
||
if (isTRUE(s$unvollstaendig) || !isTRUE(s$hat_defizit)) "–" else sprintf("%.2f", s$defizit_mw)),
|
||
"Stufengesamtwert" = sapply(erg$stufen_ergebnisse, function(s)
|
||
if (isTRUE(s$unvollstaendig)) "–" else sprintf("%.2f", s$stufengesamtwert)),
|
||
"Tendenz" = sapply(erg$stufen_ergebnisse, function(s) s$kategorie$text),
|
||
"Plus-/Minuspunkte" = sapply(erg$stufen_ergebnisse, function(s)
|
||
if (isTRUE(s$unvollstaendig)) "–" else paste0(s$pluspunkte, " / ", s$minuspunkte)),
|
||
check.names = FALSE, stringsAsFactors = FALSE
|
||
)
|
||
doc = body_add_table(doc, profil_df)
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
|
||
# Einzelitems je Stufe, gruppiert nach Ressourcen (P) / Defizit (M), mit
|
||
# farbig hinterlegtem Rohwert (an pg13r/app.R angelehnt).
|
||
doc = body_add_fpar(doc, fpar(ftext("Einzelitems je Stufe", fp_abschnitt)))
|
||
fp_gruppe = fp_text(bold = TRUE, font.size = 10, color = "#777777")
|
||
|
||
for (s in erg$stufen_ergebnisse) {
|
||
doc = body_add_fpar(doc, fpar(ftext(s$name, fp_text(bold = TRUE, font.size = 12, color = AKZENT_FARBE))))
|
||
|
||
for (gruppe in list(list(titel = "Ressourcen (P)", items = s$p_items),
|
||
list(titel = "Defizit (M)", items = s$m_items))) {
|
||
doc = body_add_fpar(doc, fpar(ftext(toupper(gruppe$titel), fp_gruppe)))
|
||
if (nrow(gruppe$items) == 0) {
|
||
doc = body_add_fpar(doc, fpar(ftext("Keine Items in dieser Gruppe.", fp_normal)))
|
||
next
|
||
}
|
||
for (r in seq_len(nrow(gruppe$items))) {
|
||
wert = gruppe$items$wert[r]
|
||
wert_k = if (!is.na(wert) && wert >= 0 && wert <= 5) as.character(as.integer(wert)) else NA_character_
|
||
fp_badge = if (!is.na(wert_k))
|
||
fp_text(bold = TRUE, font.size = 10,
|
||
color = VDS31_BADGE_TEXT_FARBEN[[wert_k]], shading.color = VDS31_BADGE_FARBEN[[wert_k]])
|
||
else
|
||
fp_text(bold = TRUE, font.size = 10, color = "#555555", shading.color = "#E0E0E0")
|
||
|
||
doc = body_add_fpar(doc, fpar(
|
||
ftext(paste0(r, ". ", gruppe$items$text[r], " "), fp_normal),
|
||
ftext(paste0(" ", vds31_anker_text(wert), " "), fp_badge)
|
||
))
|
||
}
|
||
}
|
||
doc = body_add_par(doc, "", style = "Normal")
|
||
}
|
||
|
||
doc = body_add_fpar(doc, fpar(ftext(VDS31_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.
|
||
ergebnis = 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 = "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)))
|
||
}
|
||
|
||
# Schritt 1: Download-Skript sourcen.
|
||
ok_dl = tryCatch({
|
||
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
|
||
list(ok = TRUE)
|
||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||
if (!ok_dl$ok) return(list(typ = "skript_fehler", meldung = ok_dl$msg))
|
||
|
||
# Schritt 2: pseudonyme.db suchen (bis zu 5 Ebenen ueber dem Pseudonym-Skript).
|
||
db_ordner = local({
|
||
ordner = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||
gefunden = NULL
|
||
for (i in 1:5) {
|
||
if (file.exists(file.path(ordner, "pseudonyme.db"))) { gefunden = ordner; break }
|
||
elternteil = dirname(ordner)
|
||
if (elternteil == ordner) break
|
||
ordner = elternteil
|
||
}
|
||
gefunden
|
||
})
|
||
if (is.null(db_ordner)) return(list(typ = "db_nicht_gefunden"))
|
||
|
||
# Schritt 3/4: Pseudonym-Skript sourcen (relativer DB-Zugriff, daher
|
||
# setwd mit sofortigem on.exit davor).
|
||
alter_wd = getwd()
|
||
on.exit(setwd(alter_wd), add = TRUE)
|
||
setwd(db_ordner)
|
||
|
||
ok_ps = tryCatch({
|
||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||
list(ok = TRUE)
|
||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||
if (!ok_ps$ok) return(list(typ = "skript_fehler", meldung = ok_ps$msg))
|
||
|
||
# Schritt 5: erwartete Objekte pruefen.
|
||
if (!exists("daten_vds31", envir = .GlobalEnv) || !exists("pseudo", envir = .GlobalEnv)) {
|
||
return(list(typ = "daten_fehlen"))
|
||
}
|
||
|
||
daten = get("daten_vds31", envir = .GlobalEnv)
|
||
pseudo_df = get("pseudo", envir = .GlobalEnv)
|
||
|
||
if (!("session" %in% names(daten))) {
|
||
return(list(typ = "daten_fehlen",
|
||
meldung = paste0(
|
||
"Erwartete Spalte 'session' nicht in 'daten_vds31' gefunden. ",
|
||
"Bitte Session-ID-Spaltenname vor Produktiveinsatz pruefen."
|
||
)))
|
||
}
|
||
|
||
# Schritt 6: Chiffre-Rueckaufloesung, falls nur Pseudonym eingegeben wurde.
|
||
if (nchar(trimws(input$pseudonym)) > 0) {
|
||
pw_treffer = pseudo_df[pseudo_df$pseudonym == trimws(input$pseudonym), ]
|
||
if (nrow(pw_treffer) > 0) chiffre = toupper(trimws(pw_treffer$chiffre[1]))
|
||
}
|
||
|
||
# Schritt 7: Chiffre -> moegliche Pseudonyme (Session-IDs), Eindeutigkeits-Override.
|
||
treffer_ps = pseudo_df[toupper(trimws(pseudo_df$chiffre)) == chiffre, ]
|
||
if (nrow(treffer_ps) == 0) return(list(typ = "chiffre_nicht_gefunden", chiffre = chiffre))
|
||
|
||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||
|
||
# Schritt 8: passende Datensaetze in daten_vds31 finden.
|
||
treffer_daten = daten[daten$session %in% alle_session_ids, ]
|
||
if (nrow(treffer_daten) == 0) return(list(typ = "kein_treffer", chiffre = chiffre))
|
||
|
||
mehrfach_warnung = NULL
|
||
if (nrow(treffer_daten) > 1) {
|
||
n = nrow(treffer_daten)
|
||
zeitspalte = intersect(c("ended", "created"), names(treffer_daten))
|
||
if (length(zeitspalte) > 0) {
|
||
treffer_daten = treffer_daten[order(treffer_daten[[zeitspalte[1]]], decreasing = TRUE), ]
|
||
}
|
||
treffer_daten = treffer_daten[1, , drop = FALSE]
|
||
mehrfach_warnung = paste0(
|
||
"Mehrere Ausfüllungen gefunden (", n, " Einträge) — es wird die neueste angezeigt."
|
||
)
|
||
}
|
||
zeile = treffer_daten[1, , drop = FALSE]
|
||
|
||
# Exakte Spalte fuer das Ausfuelldatum in daten_vds31 ist laut
|
||
# Spezifikation NICHT vorab verifiziert (vermutlich 'ended' oder
|
||
# 'created' aus dem formr-Export) - beim ersten Testlauf gegen die
|
||
# echten Daten pruefen, nicht raten (Abschnitt 3.6 / 4 der Spezifikation).
|
||
ausfuelldatum = tryCatch({
|
||
kandidaten = c("ausfuelldatum", "ended", "created")
|
||
spalte = intersect(kandidaten, names(zeile))
|
||
if (length(spalte) > 0) {
|
||
roh = zeile[[spalte[1]]][1]
|
||
as.Date(as.POSIXct(as.character(roh)))
|
||
} else {
|
||
Sys.Date()
|
||
}
|
||
}, error = function(e) Sys.Date())
|
||
|
||
# Schritt 9: 66 Item-Rohwerte extrahieren, dabei jeden Extraktionsfehler
|
||
# abfangen (kein stiller Fallback, klare Fehlermeldung an die UI).
|
||
roh = tryCatch({
|
||
vals = sapply(item_tabelle$feldname, function(f) {
|
||
if (!(f %in% names(daten))) {
|
||
stop("Erwartetes Item '", f, "' nicht in 'daten_vds31' gefunden.")
|
||
}
|
||
extrahiere_stufe(daten[[f]], zeile[[f]])
|
||
})
|
||
names(vals) = item_tabelle$feldname
|
||
list(ok = TRUE, werte = vals)
|
||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||
if (!roh$ok) return(list(typ = "extraktion_fehler", meldung = roh$msg))
|
||
|
||
stufen_ergebnisse = berechne_stufen_ergebnisse(item_tabelle, roh$werte, VDS31_ITEM_TEXTE)
|
||
|
||
list(
|
||
typ = "erfolg",
|
||
chiffre = chiffre,
|
||
ausfuelldatum = ausfuelldatum,
|
||
mehrfach_warnung = mehrfach_warnung,
|
||
stufen_ergebnisse = stufen_ergebnisse
|
||
)
|
||
})
|
||
|
||
vds31_fehlermeldung = function(d) {
|
||
switch(d$typ,
|
||
"leere_eingabe" = d$meldung,
|
||
"format_fehler" = paste0("Ungültige Chiffre '", d$chiffre, "'. Erwartet: ein Großbuchstabe + 6 Ziffern (z.B. P000123)."),
|
||
"skript_fehler" = paste0("Fehler beim Sourcen eines externen Skripts: ", d$meldung),
|
||
"db_nicht_gefunden" = "Die Datei 'pseudonyme.db' konnte in den übergeordneten Verzeichnissen nicht gefunden werden.",
|
||
"daten_fehlen" = if (!is.null(d$meldung)) d$meldung else "Nach dem Sourcen der Skripte fehlen die erwarteten Objekte 'daten_vds31' oder 'pseudo'.",
|
||
"chiffre_nicht_gefunden" = paste0("Chiffre '", d$chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden."),
|
||
"kein_treffer" = paste0("Kein VDS31-Datensatz für Chiffre '", d$chiffre, "' gefunden."),
|
||
"extraktion_fehler" = paste0("Fehler bei der Auswertung der Item-Rohwerte: ", d$meldung),
|
||
"Unbekannter Fehler."
|
||
)
|
||
}
|
||
|
||
output$fehler_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
d = ergebnis()
|
||
if (d$typ != "erfolg") div(class = "alert-fehler", vds31_fehlermeldung(d))
|
||
})
|
||
|
||
output$warnung_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
d = ergebnis()
|
||
if (d$typ != "erfolg" || is.null(d$mehrfach_warnung)) return(NULL)
|
||
div(class = "alert-warnung", d$mehrfach_warnung)
|
||
})
|
||
|
||
output$ergebnis_ui = renderUI({
|
||
req(input$btn_suchen)
|
||
d = ergebnis()
|
||
if (d$typ != "erfolg") return(NULL)
|
||
|
||
stufen_zeilen_ui = lapply(d$stufen_ergebnisse, function(s) {
|
||
div(class = "stufen-zeile",
|
||
div(class = "stufen-name", s$name),
|
||
div(class = "stufen-wert",
|
||
if (isTRUE(s$unvollstaendig)) "unvollständig"
|
||
else paste0("Stufengesamtwert: ", sprintf("%.2f", s$stufengesamtwert), " / 10")
|
||
),
|
||
span(class = paste0("tendenz-badge tendenz-", s$kategorie$klasse), s$kategorie$text),
|
||
div(class = "punkte-text",
|
||
if (!isTRUE(s$unvollstaendig)) paste0(s$pluspunkte, " Pluspunkte · ", s$minuspunkte, " Minuspunkte")
|
||
)
|
||
)
|
||
})
|
||
|
||
karte_profil = div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "VDS31 – Stufenprofil"),
|
||
|
||
div(class = "meta-block",
|
||
tags$strong("Chiffre: "), d$chiffre,
|
||
tags$span(" | ", style = "color:#ccc;"),
|
||
tags$strong("Ausfülldatum: "), format(d$ausfuelldatum, "%d.%m.%Y")
|
||
),
|
||
|
||
div(class = "ipsativ-hinweis", VDS31_IPSATIV_HINWEIS),
|
||
|
||
plotOutput("profil_plot", height = "380px"),
|
||
|
||
tags$hr(),
|
||
|
||
div(stufen_zeilen_ui),
|
||
|
||
div(class = "disclaimer-zeile", VDS31_DISCLAIMER)
|
||
)
|
||
|
||
# Einzelitems je Stufe, gruppiert nach Ressourcen (P) / Defizit (M),
|
||
# mit farbigen Badges pro Rohwert (an pg13r/app.R angelehnt).
|
||
vds31_item_zeile = function(nr, text, wert) {
|
||
div(class = "item-zeile",
|
||
div(class = "item-nr", paste0(nr, ".")),
|
||
div(class = "item-text", text),
|
||
span(class = "stufe-badge", style = vds31_badge_style(wert), vds31_anker_text(wert))
|
||
)
|
||
}
|
||
vds31_item_gruppe_ui = function(titel, items_df) {
|
||
div(class = "item-gruppe",
|
||
div(class = "item-gruppe-titel", titel),
|
||
if (nrow(items_df) > 0)
|
||
lapply(seq_len(nrow(items_df)), function(i)
|
||
vds31_item_zeile(i, items_df$text[i], items_df$wert[i]))
|
||
else
|
||
div(class = "item-gruppe-leer", "Keine Items in dieser Gruppe.")
|
||
)
|
||
}
|
||
|
||
stufen_items_ui = lapply(d$stufen_ergebnisse, function(s) {
|
||
tagList(
|
||
div(class = "stufe-untertitel", s$name),
|
||
div(class = "item-gruppen-wrap",
|
||
vds31_item_gruppe_ui("Ressourcen (P)", s$p_items),
|
||
vds31_item_gruppe_ui("Defizit (M)", s$m_items)
|
||
)
|
||
)
|
||
})
|
||
|
||
karte_items = div(class = "abschnitt-karte",
|
||
div(class = "abschnitt-titel", "Einzelitems je Stufe"),
|
||
stufen_items_ui
|
||
)
|
||
|
||
tagList(karte_profil, karte_items)
|
||
})
|
||
|
||
output$profil_plot = renderPlot({
|
||
req(input$btn_suchen)
|
||
d = ergebnis()
|
||
req(d$typ == "erfolg")
|
||
make_vds31_profil_plot(d$stufen_ergebnisse)
|
||
}, bg = "transparent")
|
||
|
||
output$download_word = downloadHandler(
|
||
filename = function() {
|
||
d = tryCatch(ergebnis(), error = function(e) NULL)
|
||
erfolgreich = is.list(d) && identical(d$typ, "erfolg")
|
||
chiffre_esc = if (erfolgreich && nchar(d$chiffre) > 0) gsub("[^A-Za-z0-9_-]", "_", d$chiffre) else "export"
|
||
ausfuelldatum_fn = if (erfolgreich) {
|
||
tryCatch(format(as.Date(d$ausfuelldatum), "%Y%m%d"),
|
||
error = function(e) format(Sys.Date(), "%Y%m%d"))
|
||
} else {
|
||
format(Sys.Date(), "%Y%m%d")
|
||
}
|
||
paste0("VDS31_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||
},
|
||
content = function(file) {
|
||
d = tryCatch(ergebnis(), error = function(e) NULL)
|
||
erfolgreich = is.list(d) && identical(d$typ, "erfolg")
|
||
if (!erfolgreich) {
|
||
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_vds31_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)
|