Initial commit
This commit is contained in:
commit
3cba772836
1341 changed files with 532924 additions and 0 deletions
BIN
AAQ9/.RData
Normal file
BIN
AAQ9/.RData
Normal file
Binary file not shown.
1
AAQ9/.Rprofile
Normal file
1
AAQ9/.Rprofile
Normal file
|
|
@ -0,0 +1 @@
|
|||
source("renv/activate.R")
|
||||
13
AAQ9/AAQ9.Rproj
Normal file
13
AAQ9/AAQ9.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
|
||||
675
AAQ9/app.R
Normal file
675
AAQ9/app.R
Normal file
|
|
@ -0,0 +1,675 @@
|
|||
# Präambel ####
|
||||
|
||||
library(shiny)
|
||||
library(dplyr)
|
||||
library(ggplot2)
|
||||
library(haven)
|
||||
library(officer)
|
||||
library(DBI)
|
||||
library(RSQLite)
|
||||
# Hinweis: 'formr' wird nur vom externen Download-Skript benoetigt und dort geladen
|
||||
# (nicht auf CRAN: remotes::install_github("rubenarslan/formr")). Bewusst kein
|
||||
# library(formr) hier, damit die App auch ohne dieses Paket startet.
|
||||
|
||||
# --- Instrument-Identitaet -------------------------------------------------
|
||||
# Dies ist der AAQ, 9-Item-ORIGINALVERSION (Hayes et al.), deutsche Fassung
|
||||
# Ruesch & Brueck 2003 -- NICHT der AAQ-II (10 Items, andere Kodierung, andere
|
||||
# Range). Keine Verwechslung in Text, Variablennamen oder Kommentaren.
|
||||
|
||||
AKZENT_FARBE = "#8B2635"
|
||||
|
||||
# Pfade zu den beiden extern gepflegten Skripten.
|
||||
# pg13r/app.R nutzt "../API/get_data_pg13r.R" bzw. "../get_pseudo.R" -- dieselbe
|
||||
# Ablage wird hier uebernommen. Falls die Skripte im lokalen Projektverzeichnis
|
||||
# anders liegen, hier anpassen.
|
||||
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_aaq9.R" # liefert beim Sourcen: daten_aaq9
|
||||
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R" # liefert beim Sourcen: pseudo
|
||||
|
||||
# 9 Items, Feldnamen aaq_01 .. aaq_09.
|
||||
AAQ9_ITEMS = sprintf("aaq_%02d", 1:9)
|
||||
|
||||
# 7-stufige Antwortskala, Reihenfolge = Rohwert 1..7.
|
||||
AAQ9_ANKER = c("nie", "sehr selten", "selten", "manchmal",
|
||||
"häufig", "fast immer", "immer")
|
||||
|
||||
# Umkehr-Items: finaler Wert = 8 - Rohwert. Alle uebrigen: finaler Wert = Rohwert.
|
||||
AAQ9_UMKEHR_ITEMS = c(2L, 3L, 7L, 8L, 9L)
|
||||
|
||||
# Fester Hinweistext (fehlende Normierung).
|
||||
AAQ9_HINWEIS = paste0(
|
||||
"Für dieses Instrument liegen keine publizierten Cutoff- oder Normwerte vor. ",
|
||||
"Der Flexibilitätsscore wird rein deskriptiv berichtet (Range 9–63, höhere Werte = ",
|
||||
"mehr psychische Flexibilität/Akzeptanz). Die Interpretation im Einzelfall obliegt ",
|
||||
"der behandelnden Person, ggf. im Verlauf oder im klinischen Kontext."
|
||||
)
|
||||
|
||||
# Disclaimer-Absatz fuer den Word-Export (bewusst ASCII, keine Umlaute/Sonderzeichen).
|
||||
AAQ9_DISCLAIMER = paste0(
|
||||
"Der AAQ (9-Item-Originalversion, deutsche Fassung Ruesch & Brueck 2003) misst erlebnisbezogene ",
|
||||
"Vermeidung / psychische Flexibilitaet. Fuer dieses Instrument liegen keine publizierten Cutoff- ",
|
||||
"oder Normwerte vor; der Score wird rein deskriptiv berichtet und ersetzt keine klinische Einschaetzung. ",
|
||||
"Die Interpretation obliegt der behandelnden Person."
|
||||
)
|
||||
|
||||
|
||||
# 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)
|
||||
|
||||
# Spaltennamen fuer Session-ID und Zeitstempel: aus pg13r/app.R uebernommen
|
||||
# (dort daten$session bzw. zeile[["created"]]). Gegen den echten daten_aaq9-Header
|
||||
# nicht verifizierbar -- defensiv geprueft statt blind vorausgesetzt.
|
||||
AAQ9_SPALTE_SESSION = "session"
|
||||
AAQ9_SPALTE_CREATED = "created"
|
||||
|
||||
|
||||
# Helper ####
|
||||
|
||||
# Entfernt formr-Artefakte aus dem Itemwortlaut: Markdown-Fettung (**...**),
|
||||
# Markdown-Escapes vor Satzzeichen, fuehrende Item-Nummerierung, Zeilenumbrueche.
|
||||
aaq9_bereinige_label = function(text) {
|
||||
if (is.null(text) || length(text) == 0 || is.na(text[1])) return(NA_character_)
|
||||
t = as.character(text[1])
|
||||
t = gsub("[\r\n]+", " ", t)
|
||||
t = gsub("\\*\\*", "", t, fixed = FALSE)
|
||||
t = gsub("\\\\([[:punct:]])", "\\1", t, perl = TRUE)
|
||||
t = trimws(t)
|
||||
t = sub("^\\d+\\s*[.)]?\\s*", "", t)
|
||||
t = gsub("[[:space:]]+", " ", t)
|
||||
trimws(t)
|
||||
}
|
||||
|
||||
# Itemwortlaut aus dem label-Attribut der Datenspalte. Fallback: "Item N".
|
||||
aaq9_item_text = function(daten, var, nr) {
|
||||
txt = aaq9_bereinige_label(attr(daten[[var]], "label", exact = TRUE))
|
||||
if (is.na(txt) || nchar(txt) == 0) return(paste0("Item ", nr))
|
||||
txt
|
||||
}
|
||||
|
||||
# Dekodiert eine einzelne Item-Antwort robust zu Rohwert 1..7 + Ankertext.
|
||||
# Rueckgabe: list(rohwert = int|NA, anker = chr|NA, ok = TRUE/FALSE).
|
||||
# Deckt drei Faelle ab (siehe Build-Vorgabe Abschnitt 2):
|
||||
# 1. numerische / haven_labelled Spalte: Zahl direkt als Rohwert 1..7; ein
|
||||
# vorhandenes labels-Attribut wird zur Pruefung/Zuordnung ueber den
|
||||
# Antworttext herangezogen (nicht blind die Zahl nehmen, wenn das Attribut
|
||||
# abweicht).
|
||||
# 2. Character-Spalte: exakter Stringvergleich (trimws, ** entfernt, lower)
|
||||
# gegen die sieben Textanker.
|
||||
# 3. sonst: ungueltig -> ok = FALSE (kein stillschweigendes NA im Score).
|
||||
aaq9_dekodiere_item = function(original_spalte, wert) {
|
||||
leer = list(rohwert = NA_integer_, anker = NA_character_, ok = FALSE)
|
||||
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return(leer)
|
||||
|
||||
# Fall 2: Character
|
||||
if (is.character(original_spalte) || is.character(wert)) {
|
||||
txt = tolower(trimws(gsub("\\*\\*", "", as.character(wert[1]))))
|
||||
idx = match(txt, AAQ9_ANKER)
|
||||
if (!is.na(idx)) return(list(rohwert = idx, anker = AAQ9_ANKER[idx], ok = TRUE))
|
||||
return(leer)
|
||||
}
|
||||
|
||||
# Fall 1: numerisch / haven_labelled
|
||||
num = suppressWarnings(as.numeric(wert[1]))
|
||||
lbl_attr = attr(original_spalte, "labels")
|
||||
if (!is.null(lbl_attr) && length(lbl_attr) > 0 && !is.na(num)) {
|
||||
pos = which(as.vector(lbl_attr) == num)
|
||||
if (length(pos) > 0) {
|
||||
lbl_txt = tolower(trimws(gsub("\\*\\*", "", names(lbl_attr)[pos[1]])))
|
||||
idx = match(lbl_txt, AAQ9_ANKER)
|
||||
if (!is.na(idx)) return(list(rohwert = idx, anker = AAQ9_ANKER[idx], ok = TRUE))
|
||||
# labels-Attribut vorhanden, aber Text nicht auf einen Anker abbildbar:
|
||||
# nicht blind die Zahl uebernehmen -> ungueltig.
|
||||
return(leer)
|
||||
}
|
||||
}
|
||||
|
||||
# Kein / kein passendes labels-Attribut: Zahl direkt, nur wenn ganzzahlig 1..7.
|
||||
if (!is.na(num) && num == round(num) && num >= 1 && num <= 7) {
|
||||
idx = as.integer(num)
|
||||
return(list(rohwert = idx, anker = AAQ9_ANKER[idx], ok = TRUE))
|
||||
}
|
||||
|
||||
leer
|
||||
}
|
||||
|
||||
# Klartext zu einem Fehler-/Statuslisten-Objekt aus dem eventReactive.
|
||||
aaq9_fehlertext = function(erg) {
|
||||
switch(erg$typ,
|
||||
leere_eingabe = erg$meldung,
|
||||
format_fehler = sprintf(
|
||||
"Ungültige Chiffre '%s'. Erwartet: ein Großbuchstabe + 6 Ziffern (z.B. P000123).",
|
||||
erg$chiffre
|
||||
),
|
||||
skript_fehlt = erg$meldung,
|
||||
skript_fehler = erg$meldung,
|
||||
objekt_fehlt = erg$meldung,
|
||||
spalte_fehlt = erg$meldung,
|
||||
chiffre_nicht_gefunden = erg$meldung,
|
||||
keine_daten = erg$meldung,
|
||||
item_ungueltig = erg$meldung,
|
||||
"Unbekannter Fehler."
|
||||
)
|
||||
}
|
||||
|
||||
# Horizontaler Range-Balken 9..63 mit Wertmarkierung. KEINE Farbzonen,
|
||||
# KEINE Schweregrad-Beschriftung -- rein deskriptive Positionsanzeige.
|
||||
make_range_plot_aaq9 = function(score) {
|
||||
ggplot() +
|
||||
geom_rect(aes(xmin = 9, xmax = 63, ymin = 0, ymax = 1),
|
||||
fill = "#F0F0F0", color = "#9E9E9E", linewidth = 0.6) +
|
||||
geom_segment(aes(x = score, xend = score, y = -0.15, yend = 1.15),
|
||||
color = AKZENT_FARBE, linewidth = 2.6, lineend = "round") +
|
||||
annotate("text", x = score, y = 1.45,
|
||||
label = paste0("Flexibilitätsscore: ", score),
|
||||
color = AKZENT_FARBE, fontface = "bold", size = 4.2) +
|
||||
scale_x_continuous(limits = c(6, 66), breaks = seq(9, 63, 9)) +
|
||||
scale_y_continuous(limits = c(-0.6, 1.9)) +
|
||||
labs(x = "Range 9–63 (höhere Werte = mehr psychische Flexibilität / Akzeptanz)",
|
||||
y = NULL) +
|
||||
theme_minimal(base_size = 12) +
|
||||
theme(
|
||||
axis.text.y = element_blank(),
|
||||
axis.ticks.y = element_blank(),
|
||||
panel.grid.major.y = element_blank(),
|
||||
panel.grid.minor = element_blank(),
|
||||
axis.title.y = element_blank(),
|
||||
plot.margin = margin(t = 5, r = 18, b = 12, l = 18)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# 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.9; 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; white-space: pre-wrap;
|
||||
}
|
||||
.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: 6px; color: #555; font-size: 0.95em; }
|
||||
.meta-block strong { color: #222; }
|
||||
.score-zahl { font-size: 2.4rem; font-weight: 800; color: #8B2635; line-height: 1.1; }
|
||||
.score-label { color: #555; font-size: 0.9em; }
|
||||
.hinweis-text { font-size: 0.86em; color: #555; line-height: 1.55; }
|
||||
.item-zeile {
|
||||
display: flex; align-items: flex-start; gap: 10px;
|
||||
padding: 8px 0; border-bottom: 1px solid #F0F0F0;
|
||||
}
|
||||
.item-nr { font-weight: 600; color: #8B2635; min-width: 26px; flex-shrink: 0; }
|
||||
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
||||
.item-werte {
|
||||
min-width: 230px; text-align: right; white-space: nowrap;
|
||||
font-size: 0.85em; font-weight: 600; color: #8B2635; flex-shrink: 0;
|
||||
}
|
||||
.umpol-marker { color: #888; font-weight: 500; font-style: italic; }
|
||||
"
|
||||
|
||||
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("AAQ – Acceptance and Action Questionnaire (9-Item-Originalversion)"),
|
||||
tags$p("Hayes et al.; deutsche Fassung Rüsch & Brück 2003 — nicht AAQ-II.")
|
||||
),
|
||||
|
||||
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_aaq9_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_score = fp_text(bold = TRUE, font.size = 12)
|
||||
fp_warnung = fp_text(font.size = 10, italic = TRUE, color = "#B8860B")
|
||||
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"AAQ (9-Item-Originalversion) - Einzelauswertung", fp_titel
|
||||
)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Chiffre: ", fp_label), ftext(erg$chiffre, fp_normal),
|
||||
ftext(" Ausfuelldatum: ", fp_label), ftext(erg$datum_str, fp_normal)
|
||||
))
|
||||
if (!is.null(erg$warnung)) {
|
||||
doc = body_add_fpar(doc, fpar(ftext(erg$warnung, fp_warnung)))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Flexibilitaetsscore", fp_abschnitt)))
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext("Summenwert: ", fp_label),
|
||||
ftext(paste0(erg$score, " (Range 9-63)"), fp_score)
|
||||
))
|
||||
doc = body_add_fpar(doc, fpar(ftext(
|
||||
"Hoehere Werte = mehr psychische Flexibilitaet / Akzeptanz. Keine publizierten Cutoff- oder Normwerte.",
|
||||
fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
||||
)))
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext("Einzelitems", fp_abschnitt)))
|
||||
for (i in seq_along(AAQ9_ITEMS)) {
|
||||
umgep_txt = if (erg$umgepolt[i]) " (umgepolt)" else ""
|
||||
roh = if (is.na(erg$rohwerte[i])) "k. A." else as.character(erg$rohwerte[i])
|
||||
fin = if (is.na(erg$final[i])) "k. A." else as.character(erg$final[i])
|
||||
anker = if (is.na(erg$anker[i])) "k. A." else erg$anker[i]
|
||||
doc = body_add_fpar(doc, fpar(
|
||||
ftext(paste0(i, ". ", erg$item_texte[i], umgep_txt, " "), fp_normal),
|
||||
ftext(sprintf(" Antwort: %s (%s) | Rohwert: %s | finaler Wert: %s ",
|
||||
anker, roh, roh, fin),
|
||||
fp_text(font.size = 10, bold = TRUE, color = AKZENT_FARBE))
|
||||
))
|
||||
}
|
||||
doc = body_add_par(doc, "", style = "Normal")
|
||||
|
||||
doc = body_add_fpar(doc, fpar(ftext(AAQ9_DISCLAIMER, fp_disclaimer)))
|
||||
|
||||
doc
|
||||
}
|
||||
|
||||
|
||||
# Server ####
|
||||
|
||||
server = function(input, output, session) {
|
||||
|
||||
observe({
|
||||
query = parseQueryString(session$clientData$url_search)
|
||||
if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
|
||||
updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
query = parseQueryString(session$clientData$url_search)
|
||||
if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
|
||||
updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
|
||||
}
|
||||
})
|
||||
|
||||
# Skripte werden NICHT beim App-Start gesourct, nur beim Klick auf "Auswerten".
|
||||
ergebnis_r = eventReactive(input$btn_suchen, {
|
||||
|
||||
# --- Validierung inline (Zugriff auf input noetig, nicht auslagern) ---
|
||||
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))
|
||||
}
|
||||
|
||||
# --- Skriptpfade pruefen ---
|
||||
if (!file.exists(PFAD_DOWNLOAD_SKRIPT)) {
|
||||
return(list(typ = "skript_fehlt",
|
||||
meldung = paste0("Download-Skript nicht gefunden:\n", PFAD_DOWNLOAD_SKRIPT)))
|
||||
}
|
||||
if (!file.exists(PFAD_PSEUDONYM_SKRIPT)) {
|
||||
return(list(typ = "skript_fehlt",
|
||||
meldung = paste0("Pseudonym-Skript nicht gefunden:\n", PFAD_PSEUDONYM_SKRIPT)))
|
||||
}
|
||||
|
||||
# --- Download-Skript sourcen (Return-Value-Pattern) ---
|
||||
res_dl = tryCatch(
|
||||
{ source(PFAD_DOWNLOAD_SKRIPT, local = FALSE); list(ok = TRUE) },
|
||||
error = function(e) list(ok = FALSE, msg = conditionMessage(e))
|
||||
)
|
||||
if (!isTRUE(res_dl$ok)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Fehler im Download-Skript: ", res_dl$msg)))
|
||||
}
|
||||
|
||||
# --- pseudonyme.db bis zu 5 Ebenen oberhalb des Pseudonym-Skripts suchen ---
|
||||
db_ordner = local({
|
||||
ordner = dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
gefunden = NULL
|
||||
for (i in 1:5) {
|
||||
if (file.exists(file.path(ordner, "pseudonyme.db"))) {
|
||||
gefunden = ordner
|
||||
break
|
||||
}
|
||||
elternteil = dirname(ordner)
|
||||
if (elternteil == ordner) break
|
||||
ordner = elternteil
|
||||
}
|
||||
gefunden
|
||||
})
|
||||
|
||||
alter_wd = getwd()
|
||||
on.exit(setwd(alter_wd), add = TRUE)
|
||||
wd_ziel = if (!is.null(db_ordner)) db_ordner else
|
||||
dirname(normalizePath(PFAD_PSEUDONYM_SKRIPT, mustWork = FALSE))
|
||||
setwd(wd_ziel)
|
||||
|
||||
res_ps = tryCatch(
|
||||
{ source(PFAD_PSEUDONYM_SKRIPT, local = FALSE); list(ok = TRUE) },
|
||||
error = function(e) list(ok = FALSE, msg = conditionMessage(e))
|
||||
)
|
||||
if (!isTRUE(res_ps$ok)) {
|
||||
return(list(typ = "skript_fehler",
|
||||
meldung = paste0("Fehler im Pseudonym-Skript: ", res_ps$msg)))
|
||||
}
|
||||
|
||||
# --- geforderte Objekte im GlobalEnv? ---
|
||||
if (!exists("daten_aaq9", envir = .GlobalEnv)) {
|
||||
return(list(typ = "objekt_fehlt",
|
||||
meldung = paste0("Objekt 'daten_aaq9' nach dem Sourcen nicht gefunden. ",
|
||||
"Bitte Download-Skript pruefen.")))
|
||||
}
|
||||
if (!exists("pseudo", envir = .GlobalEnv)) {
|
||||
return(list(typ = "objekt_fehlt",
|
||||
meldung = paste0("Objekt 'pseudo' nach dem Sourcen nicht gefunden. ",
|
||||
"Bitte Pseudonym-Skript pruefen.")))
|
||||
}
|
||||
|
||||
daten = get("daten_aaq9", envir = .GlobalEnv)
|
||||
pseudo = get("pseudo", envir = .GlobalEnv)
|
||||
|
||||
if (!(AAQ9_SPALTE_SESSION %in% colnames(daten))) {
|
||||
return(list(typ = "spalte_fehlt",
|
||||
meldung = sprintf("Spalte '%s' in daten_aaq9 nicht gefunden. Spaltenname im Download-Skript pruefen.",
|
||||
AAQ9_SPALTE_SESSION)))
|
||||
}
|
||||
if (!(AAQ9_SPALTE_CREATED %in% colnames(daten))) {
|
||||
return(list(typ = "spalte_fehlt",
|
||||
meldung = sprintf("Spalte '%s' (Ausfuelldatum) in daten_aaq9 nicht gefunden. Spaltenname im Download-Skript pruefen.",
|
||||
AAQ9_SPALTE_CREATED)))
|
||||
}
|
||||
fehlende_items = setdiff(AAQ9_ITEMS, colnames(daten))
|
||||
if (length(fehlende_items) > 0) {
|
||||
return(list(typ = "spalte_fehlt",
|
||||
meldung = paste0("Item-Spalten fehlen in daten_aaq9: ",
|
||||
paste(fehlende_items, collapse = ", "))))
|
||||
}
|
||||
|
||||
# --- Chiffre <-> Pseudonym aufloesen, Eindeutigkeits-Override ---
|
||||
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[pseudo$chiffre == chiffre, ]
|
||||
|
||||
# Kein Pseudonym-Treffer: nur abbrechen, wenn auch kein explizites Pseudonym
|
||||
# eingegeben wurde. Bei explizitem Pseudonym darf der Lookup direkt ueber die
|
||||
# Session-ID weiterlaufen (Pseudonym-Bypass).
|
||||
if (nrow(treffer_ps) == 0 && nchar(trimws(input$pseudonym)) == 0) {
|
||||
return(list(typ = "chiffre_nicht_gefunden",
|
||||
meldung = sprintf("Chiffre '%s' wurde in der Pseudonym-Datenbank nicht gefunden.",
|
||||
chiffre)))
|
||||
}
|
||||
|
||||
alle_session_ids = unique(treffer_ps$pseudonym)
|
||||
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
||||
|
||||
chiffre_anzeige = if (nchar(chiffre) > 0) chiffre else trimws(input$pseudonym)
|
||||
|
||||
# --- daten_aaq9 nach Session-ID(s) filtern ---
|
||||
treffer_dat = daten[daten[[AAQ9_SPALTE_SESSION]] %in% alle_session_ids, ]
|
||||
if (nrow(treffer_dat) == 0) {
|
||||
return(list(typ = "keine_daten",
|
||||
meldung = sprintf(
|
||||
"Keine AAQ-9-Daten zu dieser Session gefunden (Chiffre/Pseudonym: '%s', %d Session-ID(s) geprueft).",
|
||||
chiffre_anzeige, length(alle_session_ids))))
|
||||
}
|
||||
|
||||
# --- mehrere Ausfuellungen: neueste per created, transparent als Warnung ---
|
||||
warnung = NULL
|
||||
if (nrow(treffer_dat) > 1) {
|
||||
n = nrow(treffer_dat)
|
||||
treffer_dat = treffer_dat[order(treffer_dat[[AAQ9_SPALTE_CREATED]], decreasing = TRUE), ]
|
||||
datum_neu = tryCatch(
|
||||
format(as.POSIXct(treffer_dat[[AAQ9_SPALTE_CREATED]][1]), "%d.%m.%Y %H:%M"),
|
||||
error = function(e) "unbekanntes Datum"
|
||||
)
|
||||
warnung = sprintf(
|
||||
"Mehrere Ausfüllungen gefunden (%d Einträge). Ausgewertet wird die neueste vom %s.",
|
||||
n, datum_neu
|
||||
)
|
||||
treffer_dat = treffer_dat[1, , drop = FALSE]
|
||||
}
|
||||
|
||||
zeile = treffer_dat[1, , drop = FALSE]
|
||||
|
||||
created_roh = zeile[[AAQ9_SPALTE_CREATED]][1]
|
||||
datum_str = tryCatch(
|
||||
format(as.POSIXct(created_roh), "%d.%m.%Y"),
|
||||
error = function(e) "unbekannt"
|
||||
)
|
||||
datum_fn = tryCatch(
|
||||
format(as.Date(as.POSIXct(created_roh)), "%Y%m%d"),
|
||||
error = function(e) "unbekannt"
|
||||
)
|
||||
|
||||
# --- Items dekodieren ---
|
||||
rohwerte = integer(9)
|
||||
anker = character(9)
|
||||
ok_flags = logical(9)
|
||||
item_texte = character(9)
|
||||
for (i in seq_along(AAQ9_ITEMS)) {
|
||||
var = AAQ9_ITEMS[i]
|
||||
item_texte[i] = aaq9_item_text(daten, var, i)
|
||||
dec = aaq9_dekodiere_item(daten[[var]], zeile[[var]])
|
||||
rohwerte[i] = if (is.na(dec$rohwert)) NA_integer_ else as.integer(dec$rohwert)
|
||||
anker[i] = dec$anker
|
||||
ok_flags[i] = isTRUE(dec$ok)
|
||||
}
|
||||
|
||||
if (any(!ok_flags)) {
|
||||
betroffen = which(!ok_flags)
|
||||
return(list(typ = "item_ungueltig",
|
||||
meldung = paste0(
|
||||
"Mindestens ein Item konnte nicht eindeutig dekodiert werden ",
|
||||
"(weder als Rohwert 1-7 noch als einer der sieben Textanker): Item ",
|
||||
paste(betroffen, collapse = ", "), ". ",
|
||||
"Es wird kein Score berechnet. Bitte Datenexport / Feldformat pruefen.")))
|
||||
}
|
||||
|
||||
# --- Umpolung + Score ---
|
||||
umgepolt = seq_len(9) %in% AAQ9_UMKEHR_ITEMS
|
||||
final = ifelse(umgepolt, 8L - rohwerte, rohwerte)
|
||||
score = sum(final)
|
||||
|
||||
list(
|
||||
typ = "ok",
|
||||
chiffre = chiffre_anzeige,
|
||||
datum_str = datum_str,
|
||||
datum_fn = datum_fn,
|
||||
warnung = warnung,
|
||||
item_nr = seq_len(9),
|
||||
item_texte = item_texte,
|
||||
rohwerte = rohwerte,
|
||||
anker = anker,
|
||||
final = as.integer(final),
|
||||
umgepolt = umgepolt,
|
||||
score = score
|
||||
)
|
||||
})
|
||||
|
||||
output$fehler_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
if (!identical(erg$typ, "ok")) div(class = "alert-fehler", aaq9_fehlertext(erg))
|
||||
})
|
||||
|
||||
output$warnung_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
if (!identical(erg$typ, "ok") || is.null(erg$warnung)) return(NULL)
|
||||
div(class = "alert-warnung", erg$warnung)
|
||||
})
|
||||
|
||||
output$range_plot = renderPlot({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
req(identical(erg$typ, "ok"))
|
||||
make_range_plot_aaq9(erg$score)
|
||||
}, bg = "transparent")
|
||||
|
||||
output$ergebnis_ui = renderUI({
|
||||
req(input$btn_suchen)
|
||||
erg = ergebnis_r()
|
||||
if (!identical(erg$typ, "ok")) return(NULL)
|
||||
|
||||
items_ui = lapply(seq_len(9), function(i) {
|
||||
umpol = if (erg$umgepolt[i]) span(class = "umpol-marker", " (umgepolt)") else NULL
|
||||
div(class = "item-zeile",
|
||||
div(class = "item-nr", paste0(i, ".")),
|
||||
div(class = "item-text", erg$item_texte[i], umpol),
|
||||
div(class = "item-werte",
|
||||
sprintf("%s (%d) | Rohwert %d → Wert %d",
|
||||
erg$anker[i], erg$rohwerte[i], erg$rohwerte[i], erg$final[i]))
|
||||
)
|
||||
})
|
||||
|
||||
div(
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "AAQ – Ergebnisübersicht"),
|
||||
div(class = "meta-block",
|
||||
tags$strong("Chiffre: "), erg$chiffre,
|
||||
tags$span(style = "color:#ccc; margin:0 8px;", "|"),
|
||||
tags$strong("Ausfülldatum: "), erg$datum_str
|
||||
)
|
||||
),
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Flexibilitätsscore"),
|
||||
fluidRow(
|
||||
column(3,
|
||||
div(class = "score-zahl", erg$score),
|
||||
div(class = "score-label", "Summenwert (Range 9–63)")
|
||||
),
|
||||
column(9, plotOutput("range_plot", height = "150px"))
|
||||
)
|
||||
),
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Einzelitems"),
|
||||
div(
|
||||
style = "font-size:0.82em; color:#888; margin-bottom:6px;",
|
||||
"Umkehr-Items 2, 3, 7, 8, 9: finaler Wert = 8 − Rohwert. Übrige Items: finaler Wert = Rohwert."
|
||||
),
|
||||
div(items_ui)
|
||||
),
|
||||
|
||||
div(class = "abschnitt-karte",
|
||||
div(class = "abschnitt-titel", "Hinweis zur Interpretation"),
|
||||
p(class = "hinweis-text", AAQ9_HINWEIS)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$download_word = downloadHandler(
|
||||
filename = function() {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.null(erg) || !identical(erg$typ, "ok")) return("AAQ9_Auswertung.docx")
|
||||
chiffre_esc = gsub("[^A-Za-z0-9]", "", erg$chiffre)
|
||||
if (nchar(chiffre_esc) == 0) chiffre_esc = "export"
|
||||
ausfuelldatum_fn = if (is.null(erg$datum_fn) || is.na(erg$datum_fn)) "unbekannt" else erg$datum_fn
|
||||
paste0("AAQ9_", chiffre_esc, "_", ausfuelldatum_fn, ".docx")
|
||||
},
|
||||
content = function(file) {
|
||||
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
||||
if (is.null(erg) || !identical(erg$typ, "ok")) {
|
||||
doc = read_docx()
|
||||
doc = body_add_par(doc,
|
||||
"Kein auswertbarer Datensatz geladen. Bitte zuerst Chiffre oder Pseudonym eingeben und 'Auswerten' klicken.",
|
||||
style = "Normal")
|
||||
print(doc, target = file)
|
||||
return()
|
||||
}
|
||||
doc = tryCatch(
|
||||
erstelle_aaq9_docx(erg),
|
||||
error = function(e) {
|
||||
err_doc = read_docx()
|
||||
body_add_par(err_doc,
|
||||
paste0("Fehler beim Erstellen des Word-Dokuments: ", conditionMessage(e)),
|
||||
style = "Normal")
|
||||
}
|
||||
)
|
||||
print(doc, target = file)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
# Start ####
|
||||
|
||||
shinyApp(ui = ui, server = server)
|
||||
3019
AAQ9/renv.lock
Normal file
3019
AAQ9/renv.lock
Normal file
File diff suppressed because it is too large
Load diff
14
AAQ9/setup_renv.R
Normal file
14
AAQ9/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,
|
||||
# 'formr' vom externen Download-Skript (nicht auf CRAN).
|
||||
|
||||
renv::init()
|
||||
|
||||
pkgs = c("shiny", "dplyr", "ggplot2", "haven", "officer", "DBI", "RSQLite", "remotes", "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