server/DiagnostikApps
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
Jonas Karneboge 2026-09-22 18:35:43 +02:00
commit 3cba772836
1341 changed files with 532924 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
VDS31/.RData Normal file
View file

Binary file not shown.

1
VDS31/.Rprofile Normal file
View file

@ -0,0 +1 @@
source("renv/activate.R")

13
VDS31/VDS31.Rproj Normal file
View 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

973
VDS31/app.R Normal file
View file

@ -0,0 +1,973 @@
# 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)

2879
VDS31/renv.lock Normal file
View file

File diff suppressed because it is too large Load diff

17
VDS31/setup_renv.R Normal file
View file

@ -0,0 +1,17 @@
# Einmalig ausfuehren, bevor die App zum ersten Mal gestartet wird.
# Initialisiert renv und installiert alle benoetigten Pakete.
#
# formr wird NICHT hier installiert - es steckt ausschliesslich im extern
# gesourcten Download-Skript (get_data_vds31.R), das ausserhalb dieses
# App-Verzeichnisses liegt und seine eigenen Abhaengigkeiten mitbringt.
# 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()")