Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
BIN
AFKA-I/.RData
Normal file
BIN
AFKA-I/.RData
Normal file
Binary file not shown.
1
AFKA-I/.Rprofile
Normal file
1
AFKA-I/.Rprofile
Normal file
|
|
@ -0,0 +1 @@
|
|||
source("renv/activate.R")
|
||||
13
AFKA-I/AFKA-I.Rproj
Normal file
13
AFKA-I/AFKA-I.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
|
||||
875
AFKA-I/app.R
Normal file
875
AFKA-I/app.R
Normal file
|
|
@ -0,0 +1,875 @@
|
|||
# Präambel ####
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_afkai.R" # liefert beim Sourcen: daten_afka
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert beim Sourcen: pseudo
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
AFKA_DISCLAIMER = paste0(
|
||||
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
||||
"keine klinische Diagnose. Es handelt sich um eine reine Profildarstellung relativ zur ",
|
||||
"Normstichprobe, ohne definierten Cutoff. Die Interpretation obliegt der behandelnden Person."
|
||||
)
|
||||
|
||||
# Stammsaetze/Fragen der drei Frageboden-Abschnitte, woertlich aus den note-Zeilen
|
||||
# afka_p1_intro / afka_p2_intro / afka_p3_intro in afka.xlsx uebernommen. Diese
|
||||
# note-Zeilen sind reiner Anzeigetext im Fragebogen und tauchen nicht als Spalten
|
||||
# im formr-Export (daten_afka) auf, koennen also nicht zur Laufzeit ausgelesen
|
||||
# werden - deshalb hier als statischer Text hinterlegt.
|
||||
AFKA_URSACHEN_INTRO = paste0(
|
||||
"Sie haben sich vermutlich schon eigene Gedanken über mögliche Gründe / Bedingungen ",
|
||||
"für Ihre Beschwerden gemacht. Bitte kreuzen Sie in diesem Sinne aus Ihrer persönlichen ",
|
||||
"Perspektive jeden der unten aufgeführten Aspekte auf der Skala von 1 bis 5 an."
|
||||
)
|
||||
AFKA_URSACHEN_STAMMSATZ = "Meine Beschwerden sind (mit)bedingt durch ..."
|
||||
|
||||
AFKA_FREMDKONTROLLE_FRAGE = "Wie stark können die folgenden Personen Einfluß auf die Besserung Ihrer Beschwerden nehmen?"
|
||||
|
||||
AFKA_SELBSTKONTROLLE_FRAGE = "Wo können Sie selbst aus eigener Kraft auf die Besserung Ihrer Beschwerden Einfluß nehmen?"
|
||||
AFKA_SELBSTKONTROLLE_STAMMSATZ = "Bei ..."
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
library(DBI)
|
||||
library(RSQLite)
|
||||
|
||||
|
||||
# Infrastruktur ####
|
||||
|
||||
APP_VERZEICHNIS = normalizePath(getwd())
|
||||
|
||||
absPath = function(pfad) {
|
||||
if (grepl("^([A-Za-z]:[/\\\\]|/)", pfad)) return(pfad)
|
||||
file.path(APP_VERZEICHNIS, pfad)
|
||||
}
|
||||
|
||||
PFAD_DOWNLOAD_SKRIPT = normalizePath(absPath(PFAD_DOWNLOAD_SKRIPT), mustWork = FALSE)
|
||||
PFAD_PSEUDONYM_SKRIPT = normalizePath(absPath(PFAD_PSEUDONYM_SKRIPT), mustWork = FALSE)
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# Item -> Faktor-Zuordnung (Rohmittelwerte 1-5), korrigierte Feldzuordnung wegen
|
||||
# einer bekannten Feldvertauschung beim Bau von afka.xlsx (siehe auswertung_normen_gbb.md
|
||||
# Abschnitt 2.2). Die afka_NN-Feldnamen sind bereits korrekt, NICHT die im Label
|
||||
# angezeigte Itemnummer verwenden und afka.xlsx/Zuordnung nicht veraendern.
|
||||
AFKA_FAKTOREN = list(
|
||||
familie = list(label = "Familie", items = c(12, 21, 33, 53, 15, 18, 41, 8, 13, 19)),
|
||||
selbst = list(label = "Selbst", items = c(26, 1, 27, 52, 40, 50, 54, 46, 24, 35, 3)),
|
||||
partnerschaft = list(label = "Partnerschaft", items = c(34, 42, 30, 22, 9, 43)),
|
||||
stress = list(label = "Streß", items = c(4, 44, 7, 16, 48, 56, 47, 6)),
|
||||
finanzen = list(label = "Finanzen", items = c(28, 32, 25, 39, 49)),
|
||||
schicksal = list(label = "Schicksal", items = c(31, 38, 51, 17)),
|
||||
koerper = list(label = "Körper", items = c(14, 37, 5, 23)),
|
||||
sucht = list(label = "Sucht", items = c(10, 2, 45, 36))
|
||||
)
|
||||
|
||||
# Reihenfolge fuer Anzeige und Grafik, fest (nicht nach Wert sortiert).
|
||||
AFKA_FAKTOR_REIHENFOLGE = c("familie", "selbst", "partnerschaft", "stress",
|
||||
"finanzen", "schicksal", "koerper", "sucht")
|
||||
|
||||
# Items, die in keinen Faktor eingehen, nur als Rohwert anzeigbar.
|
||||
AFKA_UNZUGEORDNETE_ITEMS = c(
|
||||
afka_11 = "Eifersucht",
|
||||
afka_20 = "Haß",
|
||||
afka_29 = "Organismus",
|
||||
afka_55 = "Wut"
|
||||
)
|
||||
|
||||
# Erwartete Antwortanker, inhaltlich Skala 1-5. Die formr-Rohzahl wird NIE blind
|
||||
# uebernommen: pro Item wird ueber das labels-Attribut der Original-Spalte der
|
||||
# Ankertext des Rohwerts bestimmt und darueber auf den Standardwert 1-5
|
||||
# abgebildet. Das ist robust gegen eine abweichende interne Kodierung.
|
||||
AFKA_ANKER_STANDARD = c(
|
||||
"gar nicht" = 1,
|
||||
"kaum" = 2,
|
||||
"mittelmäßig" = 3,
|
||||
"ziemlich stark" = 4,
|
||||
"sehr stark" = 5
|
||||
)
|
||||
|
||||
afka_normalisiere_text = function(text) {
|
||||
text = tolower(trimws(text))
|
||||
text = gsub("ä", "ae", text); text = gsub("ö", "oe", text); text = gsub("ü", "ue", text)
|
||||
text = gsub("ß", "ss", text)
|
||||
text
|
||||
}
|
||||
|
||||
# Loest den Rohwert eines AFKA-Items robust ueber den Ankertext auf. Liefert bei
|
||||
# fehlendem/unpassendem Ankertext oder einem Ergebnis ausserhalb 1-5 KEINEN
|
||||
# geratenen Wert, sondern NA plus eine Warnmeldung statt stiller Fehlberechnung.
|
||||
afka_resolve_item = function(item_name, original_spalte, wert) {
|
||||
roh = if (is.null(wert) || length(wert) == 0) NA else wert[1]
|
||||
if (is.na(roh)) return(list(wert = NA_real_, anker = NA_character_, warnung = NULL))
|
||||
|
||||
lbl_attr = attr(original_spalte, "labels")
|
||||
if (is.null(lbl_attr) || length(lbl_attr) == 0) {
|
||||
return(list(wert = NA_real_, anker = NA_character_, warnung = paste0(
|
||||
item_name, ": keine Antwortlabels in den Daten gefunden, Rohwert nicht auswertbar.")))
|
||||
}
|
||||
|
||||
pos = which(as.vector(lbl_attr) == as.numeric(roh))
|
||||
if (length(pos) == 0) {
|
||||
return(list(wert = NA_real_, anker = NA_character_, warnung = paste0(
|
||||
item_name, ": Rohwert ", roh, " passt zu keinem Antwortlabel.")))
|
||||
}
|
||||
anker_text = names(lbl_attr)[pos[1]]
|
||||
|
||||
standard_norm = afka_normalisiere_text(names(AFKA_ANKER_STANDARD))
|
||||
treffer = match(afka_normalisiere_text(anker_text), standard_norm)
|
||||
if (is.na(treffer)) {
|
||||
return(list(wert = NA_real_, anker = anker_text, warnung = paste0(
|
||||
item_name, ": Ankertext '", anker_text, "' gehoert nicht zur erwarteten Antwortskala ",
|
||||
"(gar nicht/kaum/mittelmäßig/ziemlich stark/sehr stark).")))
|
||||
}
|
||||
|
||||
wert_std = as.numeric(AFKA_ANKER_STANDARD[[treffer]])
|
||||
if (wert_std < 1 || wert_std > 5) {
|
||||
return(list(wert = NA_real_, anker = anker_text, warnung = paste0(
|
||||
item_name, ": aufgeloester Wert ", wert_std, " liegt ausserhalb des erwarteten Bereichs 1-5.")))
|
||||
}
|
||||
|
||||
list(wert = wert_std, anker = anker_text, warnung = NULL)
|
||||
}
|
||||
|
||||
# Entfernt Markdown-Sternchen ("**Text**") und die fuehrende Itemnummer samt
|
||||
# literalem Backslash-Punkt (z.B. "15\\. meine ..."), OHNE auf einen einfachen
|
||||
# Punkt zu matchen (sonst bricht die Trennung bei Dezimalzahlen im Itemtext).
|
||||
afka_clean_label = function(text) {
|
||||
if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
|
||||
txt = as.character(text[1])
|
||||
txt = gsub("\\*\\*", "", txt)
|
||||
txt = sub("^\\s*\\d+\\\\\\.\\s*", "", txt)
|
||||
trimws(txt)
|
||||
}
|
||||
|
||||
afka_item_text = function(daten, var, fallback_nr) {
|
||||
if (is.null(daten[[var]])) return(paste0("Item ", fallback_nr))
|
||||
txt = afka_clean_label(attr(daten[[var]], "label"))
|
||||
if (is.na(txt) || nchar(txt) == 0) paste0("Item ", fallback_nr) else txt
|
||||
}
|
||||
|
||||
# Mittelwert ueber die tatsaechlich gueltigen (nicht-NA) Items eines Faktors,
|
||||
# zusammen mit deren Anzahl fuer die Anzeige "Anzahl eingeflossener Items".
|
||||
afka_faktor_score = function(item_werte) {
|
||||
gueltig = item_werte[!is.na(item_werte)]
|
||||
list(
|
||||
mittelwert = if (length(gueltig) > 0) mean(gueltig) else NA_real_,
|
||||
n = length(gueltig)
|
||||
)
|
||||
}
|
||||
|
||||
# Badge-Farbverlauf gruen -> dunkelrot fuer die 5 Antwortstufen 1-5, an den
|
||||
# Farben des PG-13-R-Schwesterprojekts orientiert (dort 5 Stufen 0-4 mit
|
||||
# identischer Farbfolge).
|
||||
AFKA_BADGE_FARBEN = c(
|
||||
"1" = "#4CAF50",
|
||||
"2" = "#F48FB1",
|
||||
"3" = "#EF5350",
|
||||
"4" = "#B71C1C",
|
||||
"5" = "#4A0000"
|
||||
)
|
||||
AFKA_BADGE_TEXT_FARBEN = c(
|
||||
"1" = "white",
|
||||
"2" = "#333333",
|
||||
"3" = "white",
|
||||
"4" = "white",
|
||||
"5" = "white"
|
||||
)
|
||||
|
||||
afka_titelcase = function(text) {
|
||||
if (is.na(text) || nchar(text) == 0) return(text)
|
||||
paste0(toupper(substr(text, 1, 1)), substr(text, 2, nchar(text)))
|
||||
}
|
||||
|
||||
# Farbiger Wert-Badge fuer ein Einzelitem: Hintergrundfarbe nach Stufe 1-5,
|
||||
# Beschriftung mit dem tatsaechlichen Ankertext statt der blossen Zahl.
|
||||
afka_badge_ui = function(wert, anker) {
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert)) {
|
||||
return(span(class = "stufe-badge stufe-badge-fehlend", "k. A."))
|
||||
}
|
||||
sk = as.character(round(wert))
|
||||
text = if (!is.null(anker) && length(anker) > 0 && !is.na(anker) && nchar(anker) > 0) {
|
||||
afka_titelcase(anker)
|
||||
} else {
|
||||
as.character(wert)
|
||||
}
|
||||
span(class = paste0("stufe-badge stufe-badge-", sk), text)
|
||||
}
|
||||
|
||||
make_profil_plot = function(faktor_tab) {
|
||||
faktor_tab$label = factor(faktor_tab$label, levels = rev(faktor_tab$label))
|
||||
ggplot(faktor_tab, aes(x = label, y = z)) +
|
||||
geom_hline(yintercept = 0, color = "grey40", linewidth = 0.6) +
|
||||
geom_col(fill = AKZENT_FARBE, width = 0.6, na.rm = TRUE) +
|
||||
coord_flip() +
|
||||
labs(x = NULL, y = "z-Wert (Stichprobenmittel Wälte & Kröger, N = 1000, = 0)") +
|
||||
theme_minimal(base_size = 12) +
|
||||
theme(panel.grid.minor = element_blank())
|
||||
}
|
||||
|
||||
|
||||
# Datenaufbereitung ####
|
||||
|
||||
# z-Transformationskonstanten fuer die Profildarstellung (Wälte & Kröger 1998),
|
||||
# dienen NUR der Profildarstellung, kein Cutoff. Statische Tabelle, beim
|
||||
# App-Start geladen.
|
||||
AFKA_NORM = data.frame(
|
||||
faktor = c("familie", "selbst", "partnerschaft", "stress",
|
||||
"finanzen", "schicksal", "koerper", "sucht"),
|
||||
mittelwert = c(2.20, 2.72, 2.00, 2.44, 1.65, 1.84, 2.42, 1.30),
|
||||
sd = c(1.07, 1.06, 1.23, 1.07, 0.97, 0.96, 1.12, 0.53),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
|
||||
# UI ####
|
||||
|
||||
app_css = "
|
||||
body { font-family: 'Segoe UI', Arial, sans-serif; background: #f5f5f5; }
|
||||
.container-fluid { max-width: 1100px; }
|
||||
.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;
|
||||
}
|
||||
.alert-warnung ul { margin: 4px 0 0 18px; padding: 0; }
|
||||
.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; }
|
||||
.hinweis-block {
|
||||
font-size: 0.88em; color: #555; font-style: italic;
|
||||
border-top: 1px solid #eee; margin-top: 10px; padding-top: 8px;
|
||||
}
|
||||
.stammfrage-block {
|
||||
background: #FBF3F1; border-left: 4px solid #8B2635; border-radius: 4px;
|
||||
padding: 10px 14px; margin-bottom: 14px; font-size: 0.92em; color: #444;
|
||||
}
|
||||
.stammfrage-block .stammsatz {
|
||||
color: #8B2635; font-weight: 700; font-style: italic; margin-top: 4px;
|
||||
}
|
||||
table.tabelle-werte { width: 100%; border-collapse: collapse; margin-top: 12px; }
|
||||
table.tabelle-werte th, table.tabelle-werte td {
|
||||
padding: 6px 10px; border-bottom: 1px solid #ddd; text-align: left;
|
||||
}
|
||||
table.tabelle-werte th { background: #8B2635; color: #fff; }
|
||||
.item-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px;
|
||||
padding: 7px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 70px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.stufe-badge {
|
||||
border-radius: 4px; padding: 2px 9px; font-weight: 700;
|
||||
font-size: 0.82em; white-space: nowrap; display: inline-block; flex-shrink: 0;
|
||||
}
|
||||
.stufe-badge-1 { background: #4CAF50; color: white; }
|
||||
.stufe-badge-2 { background: #F48FB1; color: #333333; }
|
||||
.stufe-badge-3 { background: #EF5350; color: white; }
|
||||
.stufe-badge-4 { background: #B71C1C; color: white; }
|
||||
.stufe-badge-5 { background: #4A0000; color: white; }
|
||||
.stufe-badge-fehlend { background: #FEECEB; color: #B71C1C; }
|
||||
"
|
||||
|
||||
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("AFKA-I – Aachener Fragebogen zur Krankheitsattribution"),
|
||||
tags$p("Wälte & Kröger 1998 | Profildarstellung relativ zur Normstichprobe")
|
||||
),
|
||||
|
||||
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_afka_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_unterabschnitt = fp_text(color = AKZENT_FARBE, bold = TRUE, italic = TRUE, font.size = 11)
|
||||
fp_label = fp_text(bold = TRUE, font.size = 11)
|
||||
fp_normal = fp_text(font.size = 11)
|
||||
fp_frage = fp_text(italic = TRUE, font.size = 10, color = "#555555")
|
||||
fp_stammsatz = fp_text(bold = TRUE, italic = TRUE, font.size = 10.5, color = AKZENT_FARBE)
|
||||
fp_warnung = fp_text(font.size = 10, italic = TRUE, color = "#BF360C")
|
||||
fp_hinweis = fp_text(font.size = 10, italic = TRUE, color = "#555555")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
fp_badge_fehlend = fp_text(color = "#B71C1C", bold = TRUE, shading.color = "#FEECEB", font.size = 10)
|
||||
|
||||
# Faerbt eine Einzelitem-Zeile analog zu den Badge-Farben in der UI (gruen
|
||||
# -> dunkelrot fuer Stufe 1-5), mit dem Ankertext statt der blossen Zahl.
|
||||
fuege_item_liste = function(doc, items, label_fn) {
|
||||
for (it in items) {
|
||||
stufe_key = if (!is.null(it$wert) && length(it$wert) > 0 && !is.na(it$wert)) {
|
||||
as.character(round(it$wert))
|
||||
} else {
|
||||
NA_character_
|
||||
}
|
||||
if (!is.na(stufe_key) && stufe_key %in% names(AFKA_BADGE_FARBEN)) {
|
||||
fp_badge = fp_text(
|
||||
color = AFKA_BADGE_TEXT_FARBEN[[stufe_key]], bold = TRUE,
|
||||
shading.color = AFKA_BADGE_FARBEN[[stufe_key]], font.size = 10
|
||||
)
|
||||
badge_txt = if (!is.null(it$anker) && length(it$anker) > 0 && !is.na(it$anker) && nchar(it$anker) > 0) {
|
||||
afka_titelcase(it$anker)
|
||||
} else {
|
||||
as.character(it$wert)
|
||||
}
|
||||
} else {
|
||||
fp_badge = fp_badge_fehlend
|
||||
badge_txt = "k. A."
|
||||
}
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(label_fn(it), " ", it$text, " "), fp_normal),
|
||||
ftext(paste0(" ", badge_txt, " "), fp_badge)
|
||||
))
|
||||
}
|
||||
doc
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("AFKA-I - Einzelauswertung", fp_titel)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_normal),
|
||||
ftext(" Ausfuelldatum: ", fp_label), ftext(erg$ausfuelldatum, fp_normal)
|
||||
))
|
||||
if (!is.null(erg$info_mehrere)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(erg$info_mehrere, fp_warnung)))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Faktorenprofil – Kausalattribution", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(AFKA_URSACHEN_INTRO, fp_frage)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0("„", AFKA_URSACHEN_STAMMSATZ, "“"), fp_stammsatz)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
faktor_tab = erg$faktor_tabelle
|
||||
tab_anzeige = data.frame(
|
||||
Faktor = faktor_tab$label,
|
||||
`Rohmittelwert (1-5)` = ifelse(is.na(faktor_tab$mittelwert), "k. A.", sprintf("%.2f", faktor_tab$mittelwert)),
|
||||
`z-Wert` = ifelse(is.na(faktor_tab$z), "k. A.", sprintf("%.2f", faktor_tab$z)),
|
||||
`Anzahl Items` = paste0(faktor_tab$n, " / ", faktor_tab$n_erwartet),
|
||||
check.names = FALSE
|
||||
)
|
||||
doc = body_add_table(doc, tab_anzeige, style = "table_template")
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Kein Gesamtscore verfuegbar (Berechnungsvorschrift nicht dokumentiert).", fp_hinweis)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Reine Profildarstellung, kein klinischer Cutoff, keine Diagnose.", fp_hinweis)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Einzelitems je Faktor", fp_abschnitt)))
|
||||
for (fk in AFKA_FAKTOR_REIHENFOLGE) {
|
||||
def = AFKA_FAKTOREN[[fk]]
|
||||
doc = body_add_fpar(doc, fpar(ftext(def$label, fp_unterabschnitt)))
|
||||
doc = fuege_item_liste(doc, erg$faktor_items[[fk]], function(it) paste0(it$nr, "."))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
}
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Nicht zugeordnete Einzelitems (nicht in Faktorenberechnung enthalten)", fp_abschnitt)))
|
||||
doc = fuege_item_liste(doc, erg$unzugeordnet, function(it) paste0(it$bezeichnung, ":"))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Fremdkontrolle – Einfluss anderer Personen auf die Besserung", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(AFKA_FREMDKONTROLLE_FRAGE, fp_frage)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Deskriptiv, unverrechnet, nicht in einer Faktorenberechnung enthalten.", fp_hinweis)))
|
||||
doc = fuege_item_liste(doc, erg$p2_werte, function(it) paste0(it$nr, "."))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Selbstkontrolle – Eigener Einfluss auf die Besserung", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(AFKA_SELBSTKONTROLLE_FRAGE, fp_frage)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(paste0("„", AFKA_SELBSTKONTROLLE_STAMMSATZ, "“"), fp_stammsatz)))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Deskriptiv, unverrechnet, nicht in einer Faktorenberechnung enthalten.", fp_hinweis)))
|
||||
doc = fuege_item_liste(doc, erg$p3_werte, function(it) paste0(it$nr, "."))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(AFKA_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_r = eventReactive(input$btn_suchen, {
|
||||
|
||||
chiffre = toupper(trimws(input$chiffre))
|
||||
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0) {
|
||||
return(list(typ = "leere_eingabe", meldung = "Bitte Chiffre oder Pseudonym eingeben."))
|
||||
}
|
||||
if (nchar(trimws(input$pseudonym)) == 0 && !grepl("^[A-Z][0-9]{6}$", chiffre)) {
|
||||
return(list(typ = "format_fehler", meldung = paste0(
|
||||
"Ungueltige Chiffre '", chiffre, "'. Erwartet: ein Grossbuchstabe + 6 Ziffern (z.B. P000123)."
|
||||
)))
|
||||
}
|
||||
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(typ = "pfad_fehler", meldung = paste0(
|
||||
"Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT
|
||||
)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(typ = "pfad_fehler", meldung = paste0(
|
||||
"Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT
|
||||
)))
|
||||
}
|
||||
|
||||
ok = tryCatch({
|
||||
source(PFAD_DOWNLOAD_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok$ok) return(list(typ = "skript_fehler", meldung = paste0(
|
||||
"Fehler im Download-Skript: ", ok$msg
|
||||
)))
|
||||
|
||||
db_ordner = local({
|
||||
ordner = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
gefunden = NULL
|
||||
for (i in 1:5) {
|
||||
if (file.exists(file.path(ordner, "pseudonyme.db"))) { gefunden = ordner; break }
|
||||
elternteil = dirname(ordner)
|
||||
if (elternteil == ordner) break
|
||||
ordner = elternteil
|
||||
}
|
||||
gefunden
|
||||
})
|
||||
if (is.null(db_ordner)) {
|
||||
return(list(typ = "db_fehler", meldung = paste0(
|
||||
"pseudonyme.db nicht gefunden (bis 5 Ebenen oberhalb von ",
|
||||
dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE)), " gesucht)."
|
||||
)))
|
||||
}
|
||||
|
||||
alter_wd = getwd()
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
setwd(db_ordner)
|
||||
|
||||
ok = tryCatch({
|
||||
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
||||
list(ok = TRUE)
|
||||
}, error = function(e) list(ok = FALSE, msg = e$message))
|
||||
if (!ok$ok) return(list(typ = "skript_fehler", meldung = paste0(
|
||||
"Fehler im Pseudonym-Skript: ", ok$msg
|
||||
)))
|
||||
|
||||
if (!exists("daten_afka", envir = .GlobalEnv) ||
|
||||
!is.data.frame(get("daten_afka", envir = .GlobalEnv))) {
|
||||
return(list(typ = "daten_fehler", meldung = paste0(
|
||||
"Objekt 'daten_afka' nach dem Sourcen nicht gefunden oder kein Dataframe. ",
|
||||
"Bitte Download-Skript pruefen."
|
||||
)))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv) ||
|
||||
!is.data.frame(get("pseudo", envir = .GlobalEnv))) {
|
||||
return(list(typ = "daten_fehler", meldung = paste0(
|
||||
"Objekt 'pseudo' nach dem Sourcen nicht gefunden oder kein Dataframe. ",
|
||||
"Bitte Pseudonym-Skript pruefen."
|
||||
)))
|
||||
}
|
||||
|
||||
daten_afka = get("daten_afka", envir = .GlobalEnv)
|
||||
pseudo = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
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]))
|
||||
}
|
||||
|
||||
treffer_ps = pseudo[toupper(trimws(as.character(pseudo$chiffre))) == chiffre, ]
|
||||
if (nrow(treffer_ps) == 0) {
|
||||
return(list(typ = "chiffre_nicht_gefunden", meldung = paste0(
|
||||
"Chiffre '", chiffre, "' wurde in der Pseudonym-Datenbank nicht gefunden."
|
||||
)))
|
||||
}
|
||||
|
||||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||||
|
||||
treffer_dat = daten_afka[daten_afka$session %in% alle_session_ids, , drop = FALSE]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(typ = "session_nicht_gefunden", meldung = paste0(
|
||||
"Kein AFKA-I-Datensatz fuer Chiffre '", chiffre, "' gefunden. (",
|
||||
length(alle_session_ids), " Pseudonym(e) geprueft)"
|
||||
)))
|
||||
}
|
||||
|
||||
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 Ausfuellungen gefunden (", n, " Eintraege). ",
|
||||
"Angezeigt wird die neueste vom ", datum_neu, "."
|
||||
)
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
ausfuelldatum = tryCatch(
|
||||
format(as.POSIXct(zeile[["created"]][1]), "%d.%m.%Y"),
|
||||
error = function(e) format(Sys.Date(), "%d.%m.%Y")
|
||||
)
|
||||
|
||||
item_warnungen = character(0)
|
||||
|
||||
# Alle 56 Hauptitems einmal aufloesen (Faktor-Items + die 4 unzugeordneten).
|
||||
item_ergebnisse = lapply(1:56, function(nr) {
|
||||
var = sprintf("afka_%02d", nr)
|
||||
erg = afka_resolve_item(var, daten_afka[[var]], zeile[[var]])
|
||||
if (!is.null(erg$warnung)) item_warnungen <<- c(item_warnungen, erg$warnung)
|
||||
list(wert = erg$wert, anker = erg$anker,
|
||||
text = afka_item_text(daten_afka, var, nr))
|
||||
})
|
||||
names(item_ergebnisse) = sprintf("afka_%02d", 1:56)
|
||||
|
||||
faktor_tabelle = do.call(rbind, lapply(AFKA_FAKTOR_REIHENFOLGE, function(fk) {
|
||||
def = AFKA_FAKTOREN[[fk]]
|
||||
werte = sapply(def$items, function(nr) item_ergebnisse[[sprintf("afka_%02d", nr)]]$wert)
|
||||
score = afka_faktor_score(werte)
|
||||
norm_z = AFKA_NORM[AFKA_NORM$faktor == fk, ]
|
||||
z = if (!is.na(score$mittelwert)) {
|
||||
(score$mittelwert - norm_z$mittelwert) / norm_z$sd
|
||||
} else {
|
||||
NA_real_
|
||||
}
|
||||
data.frame(
|
||||
faktor = fk,
|
||||
label = def$label,
|
||||
mittelwert = score$mittelwert,
|
||||
z = z,
|
||||
n = score$n,
|
||||
n_erwartet = length(def$items),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
}))
|
||||
|
||||
unzugeordnet = lapply(names(AFKA_UNZUGEORDNETE_ITEMS), function(var) {
|
||||
nr = as.integer(sub("afka_", "", var))
|
||||
it = item_ergebnisse[[var]]
|
||||
list(var = var, bezeichnung = AFKA_UNZUGEORDNETE_ITEMS[[var]],
|
||||
text = it$text, wert = it$wert, anker = it$anker)
|
||||
})
|
||||
|
||||
# Items je Faktor, numerisch sortiert, fuer die Einzelitem-Anzeige unterhalb
|
||||
# des Profils (Formel-Reihenfolge ist nur fuer die Score-Berechnung relevant).
|
||||
faktor_items = lapply(AFKA_FAKTOR_REIHENFOLGE, function(fk) {
|
||||
def = AFKA_FAKTOREN[[fk]]
|
||||
nrs = sort(def$items)
|
||||
lapply(nrs, function(nr) {
|
||||
var = sprintf("afka_%02d", nr)
|
||||
it = item_ergebnisse[[var]]
|
||||
list(var = var, nr = nr, text = it$text, wert = it$wert, anker = it$anker)
|
||||
})
|
||||
})
|
||||
names(faktor_items) = AFKA_FAKTOR_REIHENFOLGE
|
||||
|
||||
# Zusatzitems Abschnitt 2 (afka_p2_01-14) und 3 (afka_p3_01-09), rein
|
||||
# deskriptiv, KEINE Verrechnung in einen Faktor.
|
||||
p2_werte = lapply(1:14, function(nr) {
|
||||
var = sprintf("afka_p2_%02d", nr)
|
||||
erg = afka_resolve_item(var, daten_afka[[var]], zeile[[var]])
|
||||
if (!is.null(erg$warnung)) item_warnungen <<- c(item_warnungen, erg$warnung)
|
||||
list(var = var, nr = nr, text = afka_item_text(daten_afka, var, paste0("p2_", nr)),
|
||||
wert = erg$wert, anker = erg$anker)
|
||||
})
|
||||
p3_werte = lapply(1:9, function(nr) {
|
||||
var = sprintf("afka_p3_%02d", nr)
|
||||
erg = afka_resolve_item(var, daten_afka[[var]], zeile[[var]])
|
||||
if (!is.null(erg$warnung)) item_warnungen <<- c(item_warnungen, erg$warnung)
|
||||
list(var = var, nr = nr, text = afka_item_text(daten_afka, var, paste0("p3_", nr)),
|
||||
wert = erg$wert, anker = erg$anker)
|
||||
})
|
||||
|
||||
list(
|
||||
typ = "ok",
|
||||
chiffre = chiffre,
|
||||
ausfuelldatum = ausfuelldatum,
|
||||
info_mehrere = info_mehrere,
|
||||
item_warnungen = item_warnungen,
|
||||
faktor_tabelle = faktor_tabelle,
|
||||
faktor_items = faktor_items,
|
||||
unzugeordnet = unzugeordnet,
|
||||
p2_werte = p2_werte,
|
||||
p3_werte = p3_werte
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!identical(d$typ, "ok")) div(class = "alert-fehler", d$meldung)
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!identical(d$typ, "ok")) return(NULL)
|
||||
alle = c(d$info_mehrere, d$item_warnungen)
|
||||
if (length(alle) == 0) return(NULL)
|
||||
div(class = "alert-warnung", tags$ul(lapply(alle, tags$li)))
|
||||
})
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
d = ergebnis_r()
|
||||
if (!identical(d$typ, "ok")) return(NULL)
|
||||
|
||||
ft = d$faktor_tabelle
|
||||
|
||||
tabelle_faktoren = tags$table(class = "tabelle-werte",
|
||||
tags$thead(tags$tr(
|
||||
tags$th("Faktor"), tags$th("Rohmittelwert (1–5)"), tags$th("z-Wert"), tags$th("Anzahl eingeflossener Items")
|
||||
)),
|
||||
tags$tbody(
|
||||
lapply(seq_len(nrow(ft)), function(i) {
|
||||
zeile = ft[i, ]
|
||||
tags$tr(
|
||||
tags$td(zeile$label),
|
||||
tags$td(if (is.na(zeile$mittelwert)) "k. A." else sprintf("%.2f", zeile$mittelwert)),
|
||||
tags$td(if (is.na(zeile$z)) "k. A." else sprintf("%.2f", zeile$z)),
|
||||
tags$td(paste0(zeile$n, " / ", zeile$n_erwartet))
|
||||
)
|
||||
})
|
||||
)
|
||||
)
|
||||
|
||||
faktor_items_ui = lapply(seq_len(nrow(ft)), function(i) {
|
||||
zeile = ft[i, ]
|
||||
items = d$faktor_items[[zeile$faktor]]
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", paste0(zeile$label, " – Items")),
|
||||
lapply(items, function(it) {
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(it$nr, ".")),
|
||||
div(class = "item-text", it$text),
|
||||
afka_badge_ui(it$wert, it$anker)
|
||||
)
|
||||
})
|
||||
)
|
||||
})
|
||||
|
||||
unzugeordnet_ui = tags$details(
|
||||
tags$summary("Nicht zugeordnete Einzelitems (nicht in Faktorenberechnung enthalten)"),
|
||||
lapply(d$unzugeordnet, function(it) {
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", it$bezeichnung),
|
||||
div(class = "item-text", it$text),
|
||||
afka_badge_ui(it$wert, it$anker)
|
||||
)
|
||||
})
|
||||
)
|
||||
|
||||
# Abschnitt 2 (Fremdkontrolle) und 3 (Selbstkontrolle) sind inhaltlich eigene
|
||||
# Attributionsfragen (wer/was hat Einfluss auf die Besserung), nicht blosse
|
||||
# "Zusatzitems" - deshalb mit eigener Stammfrage statt generischem Titel.
|
||||
fremdkontrolle_ui = div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Fremdkontrolle – Einfluss anderer Personen auf die Besserung"),
|
||||
div(class = "stammfrage-block",
|
||||
AFKA_FREMDKONTROLLE_FRAGE
|
||||
),
|
||||
div(class = "hinweis-block", "Deskriptiv, unverrechnet, nicht in einer Faktorenberechnung enthalten."),
|
||||
lapply(d$p2_werte, function(it) {
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(it$nr, ".")),
|
||||
div(class = "item-text", it$text),
|
||||
afka_badge_ui(it$wert, it$anker)
|
||||
)
|
||||
})
|
||||
)
|
||||
|
||||
selbstkontrolle_ui = div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Selbstkontrolle – Eigener Einfluss auf die Besserung"),
|
||||
div(class = "stammfrage-block",
|
||||
AFKA_SELBSTKONTROLLE_FRAGE,
|
||||
tags$div(class = "stammsatz", AFKA_SELBSTKONTROLLE_STAMMSATZ)
|
||||
),
|
||||
div(class = "hinweis-block", "Deskriptiv, unverrechnet, nicht in einer Faktorenberechnung enthalten."),
|
||||
lapply(d$p3_werte, function(it) {
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(it$nr, ".")),
|
||||
div(class = "item-text", it$text),
|
||||
afka_badge_ui(it$wert, it$anker)
|
||||
)
|
||||
})
|
||||
)
|
||||
|
||||
tagList(
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "AFKA-I Faktorenprofil – Kausalattribution"),
|
||||
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), d$chiffre,
|
||||
tags$span(" | ", style = "color:#ccc;"),
|
||||
tags$strong("Ausfuelldatum: "), d$ausfuelldatum
|
||||
),
|
||||
|
||||
div(class = "stammfrage-block",
|
||||
AFKA_URSACHEN_INTRO,
|
||||
tags$div(class = "stammsatz", AFKA_URSACHEN_STAMMSATZ)
|
||||
),
|
||||
|
||||
plotOutput("profil_plot", height = "340px"),
|
||||
tabelle_faktoren,
|
||||
|
||||
div(class = "hinweis-block",
|
||||
"Kein klinischer Cutoff, reine Profildarstellung relativ zur Wälte & Kröger-Stichprobe (N = 1000). ",
|
||||
"Kein Gesamtscore verfügbar (Berechnungsvorschrift nicht dokumentiert)."
|
||||
)
|
||||
),
|
||||
|
||||
faktor_items_ui,
|
||||
|
||||
div(class = "abschnitt-karte", unzugeordnet_ui),
|
||||
|
||||
fremdkontrolle_ui,
|
||||
selbstkontrolle_ui
|
||||
)
|
||||
})
|
||||
|
||||
output$profil_plot = renderPlot({
|
||||
d = ergebnis_r()
|
||||
req(identical(d$typ, "ok"))
|
||||
make_profil_plot(d$faktor_tabelle)
|
||||
}, bg = "transparent")
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
chiffre_esc = if (is.list(d) && identical(d$typ, "ok") && nchar(d$chiffre) > 0) {
|
||||
gsub("[^A-Za-z0-9_-]", "_", d$chiffre)
|
||||
} else {
|
||||
"export"
|
||||
}
|
||||
ausfuelldatum_fn = tryCatch(
|
||||
format(as.Date(d$ausfuelldatum, "%d.%m.%Y"), "%Y%m%d"),
|
||||
error = function(e) format(Sys.Date(), "%Y%m%d")
|
||||
)
|
||||
if (is.na(ausfuelldatum_fn) || length(ausfuelldatum_fn) == 0) {
|
||||
ausfuelldatum_fn = format(Sys.Date(), "%Y%m%d")
|
||||
}
|
||||
paste0("AFKA_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
d = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
daten_ok = is.list(d) && identical(d$typ, "ok")
|
||||
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_afka_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)
|
||||
3019
AFKA-I/renv.lock
Normal file
3019
AFKA-I/renv.lock
Normal file
File diff suppressed because it is too large
Load diff
14
AFKA-I/setup_renv.R
Normal file
14
AFKA-I/setup_renv.R
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
# Einmalig ausfuehren, bevor die App zum ersten Mal gestartet wird.
|
||||
# Initialisiert renv und installiert alle benoetigten Pakete.
|
||||
#
|
||||
# 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