1347 lines
56 KiB
R
1347 lines
56 KiB
R
# Präambel ####
|
|
|
|
PFAD_DOWNLOAD_SKRIPT = "../API/get_data_bodyimage.R"
|
|
PFAD_PSEUDONYM_SKRIPT = "../get_pseudo.R"
|
|
AKZENT_FARBE = "#8B2635"
|
|
|
|
BODYIMAGE_DISCLAIMER = paste0(
|
|
"Diese Auswertung ist ein Hilfsmittel fuer klinisches Fachpersonal und ersetzt ",
|
|
"keine klinische Diagnose. Die Interpretation obliegt der behandelnden Person. ",
|
|
"Die Normierung gilt ausschliesslich fuer weibliche Patientinnen."
|
|
)
|
|
|
|
FRAUEN_HINWEIS_TEXT = paste0(
|
|
"Die hinterlegte Normtabelle gilt ausschließlich für weibliche Patientinnen. ",
|
|
"Für männliche Patienten liegt keine Normierung vor."
|
|
)
|
|
|
|
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 ####
|
|
|
|
# formr-Markdown-Sternchen stehen woertlich in Choice-Texten und Itemlabels.
|
|
strip_stars = function(x) {
|
|
if (is.null(x) || length(x) == 0) return(x)
|
|
gsub("\\*\\*", "", as.character(x))
|
|
}
|
|
|
|
# Liest fuer ein mc-Item (dbl+lbl) den Choice-Text ueber das labels-Attribut der
|
|
# ORIGINAL-Spalte aus und ordnet ihm dann per fest vorgegebener Tabelle (skala_map,
|
|
# Text -> Wert) den inhaltlichen Wert zu. Niemals wird der rohe formr-Code direkt
|
|
# verwertet, da formr Choice-Reihenfolgen intern beliebig durchnumeriert.
|
|
# Gibt sowohl den zugeordneten Wert als auch den Original-Choice-Text zurueck, damit
|
|
# die UI/der Word-Export den Klartext anzeigen kann, ohne die Zuordnung zu wiederholen.
|
|
melde_problem = function(warn_sammler, text) {
|
|
assign("liste", c(get("liste", envir = warn_sammler), text), envir = warn_sammler)
|
|
}
|
|
|
|
hole_item_info = function(original_spalte, wert, skala_map, item_id, warn_sammler) {
|
|
if (is.null(original_spalte)) {
|
|
melde_problem(warn_sammler, paste0(item_id, ": Spalte nicht im Datensatz gefunden."))
|
|
return(list(wert = NA_real_, text = NA_character_))
|
|
}
|
|
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) {
|
|
return(list(wert = NA_real_, text = NA_character_))
|
|
}
|
|
lbl = attr(original_spalte, "labels")
|
|
if (is.null(lbl) || length(lbl) == 0) {
|
|
melde_problem(warn_sammler, paste0(
|
|
item_id, ": keine labels im Export gefunden, Wert nicht bestimmbar."))
|
|
return(list(wert = NA_real_, text = NA_character_))
|
|
}
|
|
pos = which(as.numeric(lbl) == as.numeric(wert[1]))
|
|
if (length(pos) == 0) {
|
|
melde_problem(warn_sammler, paste0(
|
|
item_id, ": Rohwert ", wert[1], " nicht in labels-Attribut gefunden."))
|
|
return(list(wert = NA_real_, text = NA_character_))
|
|
}
|
|
choice_text = trimws(strip_stars(names(lbl)[pos[1]]))
|
|
if (!(choice_text %in% names(skala_map))) {
|
|
melde_problem(warn_sammler, paste0(
|
|
item_id, ": Choice-Text \"", choice_text, "\" nicht in erwarteter Recoding-Tabelle."))
|
|
return(list(wert = NA_real_, text = choice_text))
|
|
}
|
|
list(wert = as.numeric(skala_map[[choice_text]]), text = choice_text)
|
|
}
|
|
|
|
hole_freitext = function(original_spalte, wert) {
|
|
if (is.null(wert) || length(wert) == 0 || is.na(wert[1])) return("")
|
|
trimws(strip_stars(as.character(wert[1])))
|
|
}
|
|
|
|
leer = function(text) is.null(text) || length(text) == 0 || is.na(text) || trimws(text) == ""
|
|
|
|
# Ordnet einem Antwortwert seine Position (0-basiert) innerhalb der zugehoerigen
|
|
# Skala zu (skala_map-Werte sind immer eine luecklose Ganzzahlfolge ab min()).
|
|
# Position bestimmt ausschliesslich die Badge-Farbe, keine inhaltliche Wertung.
|
|
item_badge_position = function(wert, skala_map) {
|
|
if (is.null(wert) || length(wert) == 0 || is.na(wert)) return(NA_integer_)
|
|
as.integer(round(wert - min(skala_map)))
|
|
}
|
|
|
|
sortiere_nach_wert = function(items, feld = "wert") {
|
|
werte = sapply(items, `[[`, feld)
|
|
items[order(is.na(werte), -werte)]
|
|
}
|
|
|
|
# Ordnet einen Summenscore anhand der 5 fest vorgegebenen Baendern (min, max, stufe)
|
|
# einer Stufe zu. baender ist ein data.frame mit Spalten min, max, stufe (in dieser
|
|
# Reihenfolge sehr_gering < gering < normal < hoch < sehr_hoch).
|
|
klassifiziere_stufe = function(score, baender) {
|
|
if (is.null(score) || length(score) == 0 || is.na(score)) {
|
|
return(list(stufe = NA_character_, label = "nicht berechenbar", bereich = ""))
|
|
}
|
|
treffer = baender[score >= baender$min & score <= baender$max, ]
|
|
if (nrow(treffer) == 0) {
|
|
if (score < min(baender$min)) treffer = baender[1, ]
|
|
else treffer = baender[nrow(baender), ]
|
|
}
|
|
list(
|
|
stufe = treffer$stufe[1],
|
|
label = STUFEN_LABEL[[treffer$stufe[1]]],
|
|
bereich = paste0(treffer$min[1], "-", treffer$max[1])
|
|
)
|
|
}
|
|
|
|
stufe_css_klasse = function(stufe) {
|
|
if (is.na(stufe) || is.null(stufe)) return("stufe-badge-normal")
|
|
paste0("stufe-badge-", gsub("_", "-", stufe))
|
|
}
|
|
|
|
summe_score = function(werte) {
|
|
if (any(is.na(werte))) return(NA_real_)
|
|
sum(werte)
|
|
}
|
|
|
|
sichere_spalte = function(df, col) {
|
|
if (is.null(df) || !(col %in% names(df))) return(NULL)
|
|
df[[col]]
|
|
}
|
|
|
|
# Berechnet FB1 (Koerperzonen-Zufriedenheit): Items 01-08 gehen in den Summenscore ein,
|
|
# Items 09/10 sind reine Freitext+Rating-Zusatzangaben (nicht im Score).
|
|
berechne_fb1 = function(zeile, daten, warn_env) {
|
|
items = lapply(sprintf("%02d", 1:8), function(nr) {
|
|
col = paste0("bi_fb1_", nr)
|
|
info = hole_item_info(sichere_spalte(daten, col), sichere_spalte(zeile, col),
|
|
FB1_SKALA, paste0("FB1 Item ", nr), warn_env)
|
|
list(nr = nr, text = FB1_ITEMS[[nr]], wert = info$wert, antwort = info$text,
|
|
badge = item_badge_position(info$wert, FB1_SKALA))
|
|
})
|
|
score = summe_score(sapply(items, `[[`, "wert"))
|
|
|
|
hole_zusatz = function(n) {
|
|
col_text = paste0("bi_fb1_", n, "_text")
|
|
col_rating = paste0("bi_fb1_", n, "_rating")
|
|
text = hole_freitext(sichere_spalte(daten, col_text), sichere_spalte(zeile, col_text))
|
|
rating = hole_item_info(sichere_spalte(daten, col_rating), sichere_spalte(zeile, col_rating),
|
|
FB1_SKALA, paste0("FB1 Item ", n, " Rating"), warn_env)
|
|
list(text = text, rating_wert = rating$wert, rating_text = rating$text)
|
|
}
|
|
|
|
list(items = items, score = score,
|
|
zusatz_09 = hole_zusatz("09"), zusatz_10 = hole_zusatz("10"))
|
|
}
|
|
|
|
# Berechnet FB2 (Wunschtraum): pro Attribut Produkt aus Teilfrage A (Ist-Ideal-
|
|
# Abweichung) und B (Wichtigkeit), Summe der 10 Produkte ergibt den Score.
|
|
berechne_fb2 = function(zeile, daten, warn_env) {
|
|
items = lapply(sprintf("%02d", 1:10), function(nr) {
|
|
col_a = paste0("bi_fb2_", nr, "_a")
|
|
col_b = paste0("bi_fb2_", nr, "_b")
|
|
info_a = hole_item_info(sichere_spalte(daten, col_a), sichere_spalte(zeile, col_a),
|
|
FB2A_SKALA, paste0("FB2 Item ", nr, "a"), warn_env)
|
|
info_b = hole_item_info(sichere_spalte(daten, col_b), sichere_spalte(zeile, col_b),
|
|
FB2B_SKALA, paste0("FB2 Item ", nr, "b"), warn_env)
|
|
produkt = if (is.na(info_a$wert) || is.na(info_b$wert)) NA_real_
|
|
else info_a$wert * info_b$wert
|
|
list(nr = nr, attribut = FB2_ATTRIBUTE[[nr]],
|
|
a_wert = info_a$wert, a_text = info_a$text, a_badge = item_badge_position(info_a$wert, FB2A_SKALA),
|
|
b_wert = info_b$wert, b_text = info_b$text, b_badge = item_badge_position(info_b$wert, FB2B_SKALA),
|
|
produkt = produkt)
|
|
})
|
|
score = summe_score(sapply(items, `[[`, "produkt"))
|
|
list(items = items, score = score)
|
|
}
|
|
|
|
# Berechnet FB3 (belastende Situationen): Items 01-48 gehen in den Summenscore ein,
|
|
# Items 43-48 haben zusaetzliche Klaerfelder (Text), die den Score nicht beeinflussen.
|
|
# Items 49/50 (inkl. Ratings) sind komplett ausgeschlossen, rein qualitativ.
|
|
berechne_fb3 = function(zeile, daten, warn_env) {
|
|
items = lapply(sprintf("%02d", 1:48), function(nr) {
|
|
col = paste0("bi_fb3_", nr)
|
|
info = hole_item_info(sichere_spalte(daten, col), sichere_spalte(zeile, col),
|
|
FB3_SKALA, paste0("FB3 Item ", nr), warn_env)
|
|
klaerfeld = NULL
|
|
if (nr %in% names(FB3_KLAERFELD_LABEL)) {
|
|
col_t = paste0("bi_fb3_", nr, "_text")
|
|
txt = hole_freitext(sichere_spalte(daten, col_t), sichere_spalte(zeile, col_t))
|
|
if (!leer(txt)) klaerfeld = paste0(FB3_KLAERFELD_LABEL[[nr]], " ", txt)
|
|
}
|
|
list(nr = nr, text = FB3_ITEMS[[nr]], wert = info$wert, antwort = info$text,
|
|
badge = item_badge_position(info$wert, FB3_SKALA), klaerfeld = klaerfeld)
|
|
})
|
|
score = summe_score(sapply(items, `[[`, "wert"))
|
|
|
|
hole_zusatz = function(n) {
|
|
col_text = paste0("bi_fb3_", n, "_text")
|
|
col_rate = paste0("bi_fb3_", n)
|
|
text = hole_freitext(sichere_spalte(daten, col_text), sichere_spalte(zeile, col_text))
|
|
rating = hole_item_info(sichere_spalte(daten, col_rate), sichere_spalte(zeile, col_rate),
|
|
FB3_SKALA, paste0("FB3 Item ", n, " (Zusatz)"), warn_env)
|
|
list(text = text, rating_wert = rating$wert, rating_text = rating$text)
|
|
}
|
|
|
|
list(items = items, score = score,
|
|
zusatz_49 = hole_zusatz("49"), zusatz_50 = hole_zusatz("50"))
|
|
}
|
|
|
|
# FB4 negativ: Items 01-30 im Score, 31/32 Freitext+Rating komplett ausgeschlossen.
|
|
berechne_fb4_neg = function(zeile, daten, warn_env) {
|
|
items = lapply(sprintf("%02d", 1:30), function(nr) {
|
|
col = paste0("bi_fb4_neg_", nr)
|
|
info = hole_item_info(sichere_spalte(daten, col), sichere_spalte(zeile, col),
|
|
FB4_SKALA, paste0("FB4 negativ Item ", nr), warn_env)
|
|
list(nr = nr, text = FB4_NEG_ITEMS[[nr]], wert = info$wert, antwort = info$text,
|
|
badge = item_badge_position(info$wert, FB4_SKALA))
|
|
})
|
|
score = summe_score(sapply(items, `[[`, "wert"))
|
|
|
|
hole_zusatz = function(n) {
|
|
col_text = paste0("bi_fb4_neg_", n, "_text")
|
|
col_rate = paste0("bi_fb4_neg_", n)
|
|
text = hole_freitext(sichere_spalte(daten, col_text), sichere_spalte(zeile, col_text))
|
|
rating = hole_item_info(sichere_spalte(daten, col_rate), sichere_spalte(zeile, col_rate),
|
|
FB4_SKALA, paste0("FB4 negativ Item ", n, " (Zusatz)"), warn_env)
|
|
list(text = text, rating_wert = rating$wert, rating_text = rating$text)
|
|
}
|
|
|
|
list(items = items, score = score,
|
|
zusatz_31 = hole_zusatz("31"), zusatz_32 = hole_zusatz("32"))
|
|
}
|
|
|
|
# FB4 positiv: Items 01-15 im Score, 16/17 Freitext+Rating komplett ausgeschlossen.
|
|
berechne_fb4_pos = function(zeile, daten, warn_env) {
|
|
items = lapply(sprintf("%02d", 1:15), function(nr) {
|
|
col = paste0("bi_fb4_pos_", nr)
|
|
info = hole_item_info(sichere_spalte(daten, col), sichere_spalte(zeile, col),
|
|
FB4_SKALA, paste0("FB4 positiv Item ", nr), warn_env)
|
|
list(nr = nr, text = FB4_POS_ITEMS[[nr]], wert = info$wert, antwort = info$text,
|
|
badge = item_badge_position(info$wert, FB4_SKALA))
|
|
})
|
|
score = summe_score(sapply(items, `[[`, "wert"))
|
|
|
|
hole_zusatz = function(n) {
|
|
col_text = paste0("bi_fb4_pos_", n, "_text")
|
|
col_rate = paste0("bi_fb4_pos_", n)
|
|
text = hole_freitext(sichere_spalte(daten, col_text), sichere_spalte(zeile, col_text))
|
|
rating = hole_item_info(sichere_spalte(daten, col_rate), sichere_spalte(zeile, col_rate),
|
|
FB4_SKALA, paste0("FB4 positiv Item ", n, " (Zusatz)"), warn_env)
|
|
list(text = text, rating_wert = rating$wert, rating_text = rating$text)
|
|
}
|
|
|
|
list(items = items, score = score,
|
|
zusatz_16 = hole_zusatz("16"), zusatz_17 = hole_zusatz("17"))
|
|
}
|
|
|
|
# FB5: 44 Items, 4 Subskalen ueber wortwoertliche Additions-/Subtraktionsformeln
|
|
# aus dem Manual (keine Reverse-Scoring-Umformung pro Einzelitem).
|
|
berechne_fb5 = function(zeile, daten, warn_env) {
|
|
items = lapply(sprintf("%02d", 1:44), function(nr) {
|
|
col = paste0("bi_fb5_", nr)
|
|
info = hole_item_info(sichere_spalte(daten, col), sichere_spalte(zeile, col),
|
|
FB5_SKALA, paste0("FB5 Item ", nr), warn_env)
|
|
list(nr = nr, text = FB5_ITEMS[[nr]], wert = info$wert, antwort = info$text,
|
|
badge = item_badge_position(info$wert, FB5_SKALA))
|
|
})
|
|
werte = setNames(sapply(items, `[[`, "wert"), sapply(items, `[[`, "nr"))
|
|
|
|
formel = function(pos_range, neg_range, konstante) {
|
|
pos_summe = summe_score(werte[sprintf("%02d", pos_range)])
|
|
neg_summe = summe_score(werte[sprintf("%02d", neg_range)])
|
|
if (is.na(pos_summe) || is.na(neg_summe)) return(NA_real_)
|
|
pos_summe - neg_summe + konstante
|
|
}
|
|
|
|
list(
|
|
items = items,
|
|
A = formel(1:5, 6:7, 12),
|
|
B = formel(8:15, 16:19, 24),
|
|
C = formel(20:27, 28:30, 18),
|
|
D = formel(31:39, 40:44, 30)
|
|
)
|
|
}
|
|
|
|
make_gauge = function(score, baender, akzent, x_label) {
|
|
baender$stufe = factor(baender$stufe, levels = names(STUFEN_LABEL))
|
|
bereich_min = min(baender$min)
|
|
bereich_max = max(baender$max)
|
|
|
|
# Zonenbreiten sind ungleich (z.B. FB1 "gering" nur 3 Punkte breit) - Beschriftungen
|
|
# innerhalb der Rechtecke wuerden dort ueberlappen. Stattdessen Farbzuordnung ueber
|
|
# eine gemeinsame Legende unter dem Plot, unabhaengig von der Zonenbreite lesbar.
|
|
p = ggplot() +
|
|
geom_rect(data = baender,
|
|
aes(xmin = min, xmax = max, ymin = 0, ymax = 1, fill = stufe),
|
|
color = "white", linewidth = 0.6) +
|
|
scale_fill_manual(values = STUFEN_FARBEN, breaks = names(STUFEN_LABEL),
|
|
labels = STUFEN_LABEL, name = NULL, drop = FALSE) +
|
|
scale_x_continuous(limits = c(bereich_min, bereich_max),
|
|
breaks = c(bereich_min, bereich_max)) +
|
|
scale_y_continuous(limits = c(-0.05, 1.05)) +
|
|
guides(fill = guide_legend(nrow = 1, byrow = TRUE,
|
|
override.aes = list(linewidth = 0))) +
|
|
theme_minimal(base_size = 8) +
|
|
theme(
|
|
axis.text.y = element_blank(),
|
|
axis.ticks.y = element_blank(),
|
|
panel.grid = element_blank(),
|
|
axis.title.y = element_blank(),
|
|
axis.title.x = element_text(size = 8, color = "#555555"),
|
|
axis.text.x = element_text(size = 6.5, color = "#666666"),
|
|
legend.position = "bottom",
|
|
legend.text = element_text(size = 6.5),
|
|
legend.key.size = unit(7, "pt"),
|
|
legend.margin = margin(t = -6),
|
|
plot.margin = margin(t = 5, r = 10, b = 2, l = 10)
|
|
) +
|
|
labs(x = x_label, y = NULL)
|
|
|
|
# Kein zusaetzliches Textlabel auf dem Plot: der Zahlenwert steht bereits gross
|
|
# links neben dem Gauge (score-zahl). Ein floating geom_label ueber der Zone
|
|
# braucht Vertikal-Headroom, der bei knapper Panelhoehe abgeschnitten wird -
|
|
# daher hier nur eine schlanke Markierungslinie im Zonenbalken selbst.
|
|
if (!is.null(score) && !is.na(score)) {
|
|
p = p +
|
|
geom_segment(aes(x = score, xend = score, y = 0, yend = 1),
|
|
color = akzent, linewidth = 2, lineend = "round")
|
|
}
|
|
p
|
|
}
|
|
|
|
baue_score_karte = function(score_key, score_wert, gauge_id, item_rows, zusatz_uis = list()) {
|
|
meta = SCORE_META[[score_key]]
|
|
klass = klassifiziere_stufe(score_wert, meta$baender)
|
|
div(class = "abschnitt-karte",
|
|
div(class = "abschnitt-titel", meta$titel),
|
|
fluidRow(
|
|
column(3,
|
|
div(class = "score-zahl",
|
|
if (!is.na(score_wert)) score_wert else "-"),
|
|
div(style = "color:#555; font-size:0.85em;",
|
|
paste0("Range: ", meta$range)),
|
|
span(class = paste0("stufe-badge ", stufe_css_klasse(klass$stufe)),
|
|
klass$label)
|
|
),
|
|
column(9, plotOutput(gauge_id, height = "135px"))
|
|
),
|
|
tags$hr(),
|
|
div(item_rows),
|
|
if (length(zusatz_uis) > 0) tagList(tags$hr(), zusatz_uis)
|
|
)
|
|
}
|
|
|
|
item_badge_ui = function(wert, position) {
|
|
bk = if (is.null(position) || is.na(position)) "na" else as.character(position)
|
|
span(class = paste0("item-badge item-badge-", bk),
|
|
if (is.na(wert)) "?" else wert)
|
|
}
|
|
|
|
item_zeile_ui = function(nr, text, antwort_text, wert, badge = NA_integer_, zusatz = NULL) {
|
|
antwort_anzeige = if (is.na(wert)) {
|
|
tags$span(style = "color:#999; font-style:italic;", "keine Angabe")
|
|
} else {
|
|
tagList(
|
|
tags$span(style = "color:#555; margin-right:8px;",
|
|
if (!is.na(antwort_text)) antwort_text else ""),
|
|
item_badge_ui(wert, badge)
|
|
)
|
|
}
|
|
div(class = "item-zeile",
|
|
div(class = "item-nr", paste0(nr, ".")),
|
|
div(class = "item-text", text, zusatz),
|
|
div(style = "min-width: 260px; text-align:right;", antwort_anzeige)
|
|
)
|
|
}
|
|
|
|
fb2_item_zeile_ui = function(it) {
|
|
antwort_anzeige = if (is.na(it$a_wert) || is.na(it$b_wert)) {
|
|
tags$span(style = "color:#999; font-style:italic;", "keine Angabe")
|
|
} else {
|
|
tags$span(style = "font-size:0.88em;",
|
|
tags$span(style = "color:#555;", paste0("A: ", it$a_text, " ")),
|
|
item_badge_ui(it$a_wert, it$a_badge),
|
|
tags$span(style = "color:#555; margin: 0 6px;", paste0(" | B: ", it$b_text, " ")),
|
|
item_badge_ui(it$b_wert, it$b_badge),
|
|
tags$span(style = "color:#555; margin-left:6px;", paste0(" = ", it$produkt))
|
|
)
|
|
}
|
|
div(class = "item-zeile",
|
|
div(class = "item-nr", paste0(it$nr, ".")),
|
|
div(class = "item-text", it$attribut),
|
|
div(style = "min-width: 400px; text-align:right;", antwort_anzeige)
|
|
)
|
|
}
|
|
|
|
freitext_block_ui = function(titel, freitext, rating_text, rating_wert) {
|
|
div(class = "abschnitt-karte", style = "background:#FAFAFA;",
|
|
tags$div(style = paste0("color:", AKZENT_FARBE, "; font-weight:700; margin-bottom:4px;"),
|
|
titel),
|
|
tags$div(style = "color:#333; margin-bottom:4px;", tags$em(freitext)),
|
|
if (!is.na(rating_wert))
|
|
tags$div(style = "color:#555;",
|
|
paste0("Einordnung: ", rating_text, " (", rating_wert, ")")),
|
|
tags$div(style = "color:#888; font-size:0.82em; font-style:italic; margin-top:4px;",
|
|
"Zusätzliche qualitative Angabe, nicht im Summenscore enthalten.")
|
|
)
|
|
}
|
|
|
|
|
|
# Datenaufbereitung ####
|
|
|
|
STUFEN_LABEL = c(
|
|
sehr_gering = "sehr gering",
|
|
gering = "gering",
|
|
normal = "normal",
|
|
hoch = "hoch",
|
|
sehr_hoch = "sehr hoch"
|
|
)
|
|
# Badge-Farben fuer Einzelitem-Antworten (Position 0-4 innerhalb der jeweiligen
|
|
# Skala), analog zum bestehenden Farbverlauf gruen->dunkelrot in Schwester-Apps.
|
|
# 4-stufige Skalen (FB2 A/B, Werte 0-3) nutzen nur die Positionen 0-3.
|
|
ITEM_BADGE_FARBEN = c(
|
|
"0" = "#4CAF50",
|
|
"1" = "#F48FB1",
|
|
"2" = "#EF5350",
|
|
"3" = "#B71C1C",
|
|
"4" = "#4A0000"
|
|
)
|
|
ITEM_BADGE_TEXT_FARBEN = c(
|
|
"0" = "white",
|
|
"1" = "#333333",
|
|
"2" = "white",
|
|
"3" = "white",
|
|
"4" = "white"
|
|
)
|
|
|
|
# Gauge-Zonen und Klassifikations-Badges nutzen denselben Farbverlauf wie die
|
|
# Einzelitem-Badges (ITEM_BADGE_FARBEN), damit beide Darstellungen konsistent sind.
|
|
STUFEN_FARBEN = setNames(ITEM_BADGE_FARBEN[c("0","1","2","3","4")], names(STUFEN_LABEL))
|
|
STUFEN_TEXT_FARBEN = setNames(ITEM_BADGE_TEXT_FARBEN[c("0","1","2","3","4")], names(STUFEN_LABEL))
|
|
|
|
STUFEN_WORD_FARBEN = list(
|
|
sehr_gering = list(bg = "#E3F2FD", text = "#0D47A1"),
|
|
gering = list(bg = "#E1F5FE", text = "#01579B"),
|
|
normal = list(bg = "#E8F5E9", text = "#2E7D32"),
|
|
hoch = list(bg = "#FFF3E0", text = "#E65100"),
|
|
sehr_hoch = list(bg = "#FBE9E7", text = "#BF360C")
|
|
)
|
|
|
|
# FB1 ----
|
|
|
|
FB1_ITEMS = c(
|
|
"01" = "Gesicht (Gesichtszüge, Hautbeschaffenheit)",
|
|
"02" = "Haar (Farbe, Dicke, Struktur)",
|
|
"03" = "Unterkörper (Gesäß, Hüften, Oberschenkel, Beine)",
|
|
"04" = "Körperstamm (Taille, Bauch)",
|
|
"05" = "Oberkörper (Brüste bzw. Brust, Schultern, Arme)",
|
|
"06" = "Muskulatur",
|
|
"07" = "Gewicht",
|
|
"08" = "Größe"
|
|
)
|
|
FB1_SKALA = c(
|
|
"sehr unzufrieden" = 1,
|
|
"meistens unzufrieden" = 2,
|
|
"weder unzufrieden noch zufrieden" = 3,
|
|
"meistens zufrieden" = 4,
|
|
"sehr zufrieden" = 5
|
|
)
|
|
# Tippfehler im Original-Arbeitsblatt "33 - 402" fuer FB1/sehr hoch stillschweigend
|
|
# zu "33-40" korrigiert (Range von FB1 ist 8-40, 402 ist ausserhalb jeder moeglichen
|
|
# Itemsumme und damit ein offensichtlicher Tippfehler).
|
|
FB1_BAENDER = data.frame(
|
|
min = c(8, 23, 26, 28, 33),
|
|
max = c(22, 25, 27, 32, 40),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
|
|
# FB2 ----
|
|
|
|
FB2_ATTRIBUTE = c(
|
|
"01" = "Größe",
|
|
"02" = "Haut",
|
|
"03" = "Haarfarbe",
|
|
"04" = "Haarstruktur und -länge",
|
|
"05" = "Gesichtszüge",
|
|
"06" = "Muskulatur",
|
|
"07" = "Körperproportionen",
|
|
"08" = "Gewicht",
|
|
"09" = "Körperkraft",
|
|
"10" = "Geschicklichkeit"
|
|
)
|
|
FB2A_SKALA = c(
|
|
"genau so wie ich bin" = 0,
|
|
"annähernd so wie ich bin" = 1,
|
|
"ziemlich anders als bei mir" = 2,
|
|
"völlig anders als bei mir" = 3
|
|
)
|
|
FB2B_SKALA = c(
|
|
"nicht wichtig" = 0,
|
|
"etwas wichtig" = 1,
|
|
"ziemlich wichtig" = 2,
|
|
"sehr wichtig" = 3
|
|
)
|
|
FB2_BAENDER = data.frame(
|
|
min = c(0, 9, 18, 27, 51),
|
|
max = c(8, 17, 26, 50, 90),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
|
|
# FB3 ----
|
|
|
|
FB3_ITEMS = c(
|
|
"01" = "In sozialen Situationen, in denen ich nur wenige Menschen kenne?",
|
|
"02" = "Wenn ich im Mittelpunkt der Aufmerksamkeit stehe?",
|
|
"03" = "Wenn Menschen mich sehen, bevor ich mich zurecht gemacht habe?",
|
|
"04" = "Wenn ich mit attraktiven Menschen meines Geschlechts zusammen bin?",
|
|
"05" = "Wenn ich mit attraktiven Menschen des anderen Geschlechts zusammen bin?",
|
|
"06" = "Wenn jemand auf Teile meines Körpers schaut, die ich nicht mag?",
|
|
"07" = "Wenn Menschen mich aus einem bestimmten Winkel betrachten?",
|
|
"08" = "Wenn mir jemand Komplimente macht?",
|
|
"09" = "Wenn ich das Gefühl habe, abgelehnt oder ignoriert zu werden?",
|
|
"10" = "Wenn das Gesprächsthema sich um das Aussehen dreht?",
|
|
"11" = "Wenn sich jemand ablehnend über mein Aussehen äußert?",
|
|
"12" = "Wenn jemand anderes Komplimente bekommt und zu mir nichts gesagt wird?",
|
|
"13" = "Wenn ich höre, dass das Aussehen Anderer kritisiert wird?",
|
|
"14" = "Wenn ich mich daran erinnere, dass Andere scherzhafte oder unfreundliche Dinge über meine Erscheinung gesagt haben?",
|
|
"15" = "Wenn ich mit Anderen zusammen bin, die über Diäten oder Gewicht reden?",
|
|
"16" = "Wenn ich attraktive Menschen im Fernsehen oder in Zeitschriften sehe?",
|
|
"17" = "Wenn ich in einem Geschäft Kleidung anprobiere?",
|
|
"18" = "Wenn ich \"gewagte\" Kleidung trage?",
|
|
"19" = "Wenn ich an einem sozialen Ereignis anders als die Anderen gekleidet bin?",
|
|
"20" = "Wenn meine Kleidung nicht richtig sitzt?",
|
|
"21" = "Wenn ich eine neue Frisur habe?",
|
|
"22" = "Wenn ich nicht geschminkt bin (für Frauen)?",
|
|
"23" = "Wenn meine Frisur nicht richtig sitzt?",
|
|
"24" = "Wenn mein Partner nicht bemerkt, dass ich mich schön gemacht habe?",
|
|
"25" = "Wenn ich mich im Spiegel anschaue?",
|
|
"26" = "Wenn ich im Spiegel meinen nackten Körper anschaue?",
|
|
"27" = "Wenn ich mich auf einem Foto oder Video sehe?",
|
|
"28" = "Wenn ich fotografiert werde?",
|
|
"29" = "Wenn ich nicht so viel Sport gemacht habe wie gewöhnlich?",
|
|
"30" = "Wenn ich Sport mache?",
|
|
"31" = "Wenn ich eine ganze Mahlzeit gegessen habe?",
|
|
"32" = "Wenn ich auf der Waage stehe?",
|
|
"33" = "Wenn ich das Gefühl habe, zugenommen zu haben?",
|
|
"34" = "Wenn ich das Gefühl habe, abgenommen zu haben?",
|
|
"35" = "Wenn ich wegen etwas anderem sowieso schon schlecht gelaunt bin?",
|
|
"36" = "Wenn ich daran denke, wie ich früher ausgesehen habe?",
|
|
"37" = "Wenn ich daran denke, wie ich gern aussehen würde?",
|
|
"38" = "Wenn ich daran denke, wie ich in der Zukunft aussehen werde?",
|
|
"39" = "Wenn ich mir vorstelle, eine sexuelle Beziehung zu haben?",
|
|
"40" = "Wenn mein Partner mich unbekleidet sieht?",
|
|
"41" = "Wenn mein Partner mich an Stellen berührt, die ich an mir nicht mag?",
|
|
"42" = "Wenn mein Partner kein sexuelles Interesse an mir zeigt?",
|
|
"43" = "Wenn ich mit einer bestimmten Person zusammen bin?",
|
|
"44" = "Zu einer bestimmten Tageszeit?",
|
|
"45" = "Während einer bestimmten Zeit im Monat?",
|
|
"46" = "Während einer bestimmten Zeit im Jahr?",
|
|
"47" = "Während bestimmter erholsamer Aktivitäten?",
|
|
"48" = "Wenn ich bestimmte Lebensmittel esse?",
|
|
"49" = "Andere schwierige Situation",
|
|
"50" = "Andere schwierige Situation"
|
|
)
|
|
FB3_KLAERFELD_LABEL = c(
|
|
"43" = "Mit wem?", "44" = "Wann?", "45" = "Wann?",
|
|
"46" = "Wann?", "47" = "Welche?", "48" = "Welche?"
|
|
)
|
|
FB3_SKALA = c(
|
|
"niemals" = 0,
|
|
"manchmal" = 1,
|
|
"ziemlich häufig" = 2,
|
|
"häufig" = 3,
|
|
"fast immer" = 4
|
|
)
|
|
FB3_BAENDER = data.frame(
|
|
min = c(0, 51, 73, 81, 111),
|
|
max = c(50, 72, 80, 110, 192),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
|
|
# FB4 ----
|
|
|
|
FB4_NEG_ITEMS = c(
|
|
"01" = "Mein Leben ist elend aufgrund meines Aussehens.",
|
|
"02" = "Mein Äußeres macht mich zu einem Niemand.",
|
|
"03" = "Ich sehe nicht gut genug aus, um in dieser (einer bestimmten) Situation zu sein.",
|
|
"04" = "Warum kann ich nicht besser aussehen?",
|
|
"05" = "Es ist nicht fair, dass ich so aussehe.",
|
|
"06" = "So, wie ich aussehe, wird mich nie jemand lieben.",
|
|
"07" = "Ich wünschte, ich würde besser aussehen.",
|
|
"08" = "Ich muss unbedingt abnehmen.",
|
|
"09" = "Die Anderen denken, ich bin fett.",
|
|
"10" = "Die Anderen lachen über mein Aussehen.",
|
|
"11" = "Ich bin nicht attraktiv.",
|
|
"12" = "Ich wünschte, ich sähe wie jemand anderes aus.",
|
|
"13" = "Andere werden mich aufgrund meines Äußeren nicht mögen.",
|
|
"14" = "Ich werde nie attraktiv sein.",
|
|
"15" = "Ich hasse meinen Körper.",
|
|
"16" = "Irgend etwas muss mit meinem Aussehen passieren.",
|
|
"17" = "Wie ich aussehe, ruiniert mir alles.",
|
|
"18" = "Ich sehe nie so aus, wie ich gern möchte.",
|
|
"19" = "Ich bin so enttäuscht über meine Erscheinung.",
|
|
"20" = "Ich fühle mich unattraktiv, daher muss etwas mit meinem Aussehen nicht in Ordnung sein.",
|
|
"21" = "Ich wünschte, ich würde mir nicht so viele Sorgen um mein Aussehen machen.",
|
|
"22" = "Andere Menschen bemerken sofort, was mit meinem Körper nicht in Ordnung ist.",
|
|
"23" = "Die Menschen denken, ich bin unattraktiv.",
|
|
"24" = "Die Anderen sehen besser aus als ich.",
|
|
"25" = "Besonders wenn ich mit attraktiven Menschen zusammen bin, denke ich, dass ich hässlich bin.",
|
|
"26" = "Ich kann keine modischen Kleider tragen.",
|
|
"27" = "Mein Körper braucht mehr Konturen.",
|
|
"28" = "Meine Kleider passen nicht richtig.",
|
|
"29" = "Ich wünschte, andere würden mich nicht anschauen.",
|
|
"30" = "Ich kann mein Äußeres nicht mehr ertragen.",
|
|
"31" = "Andere häufige negative Gedanken",
|
|
"32" = "Andere häufige negative Gedanken"
|
|
)
|
|
FB4_POS_ITEMS = c(
|
|
"01" = "Andere denken, ich sehe gut aus.",
|
|
"02" = "Mein Aussehen hilft mir, selbstbewusster zu sein.",
|
|
"03" = "Ich bin stolz auf meinen Körper.",
|
|
"04" = "Mein Körper hat gute Proportionen.",
|
|
"05" = "Mein Äußeres scheint mir, gesellschaftlich hilfreich zu sein.",
|
|
"06" = "Ich mag die Art, wie ich aussehe.",
|
|
"07" = "Ich empfinde mich auch dann noch attraktiv, wenn ich mit schöneren Menschen zusammen bin.",
|
|
"08" = "Eigentlich sehe ich genauso gut aus, wie die meisten Anderen.",
|
|
"09" = "Es kümmert mich nicht, wenn Andere mich anschauen.",
|
|
"10" = "Ich bin mit meinem Aussehen zufrieden.",
|
|
"11" = "Ich sehe gesund aus.",
|
|
"12" = "Ich mag mich im Badeanzug.",
|
|
"13" = "Diese Kleider stehen mir gut.",
|
|
"14" = "Mein Körper ist nicht perfekt, aber ich denke, er ist attraktiv.",
|
|
"15" = "Ich muss mein Aussehen nicht verändern.",
|
|
"16" = "Andere häufige positive Gedanken",
|
|
"17" = "Andere häufige positive Gedanken"
|
|
)
|
|
FB4_SKALA = FB3_SKALA
|
|
FB4_NEG_BAENDER = data.frame(
|
|
min = c(0, 9, 18, 22, 40),
|
|
max = c(8, 17, 21, 39, 120),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
FB4_POS_BAENDER = data.frame(
|
|
min = c(0, 17, 27, 33, 40),
|
|
max = c(16, 26, 32, 39, 60),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
|
|
# FB5 ----
|
|
|
|
FB5_ITEMS = c(
|
|
"01" = "Mein Körper ist sexuell ansprechend.",
|
|
"02" = "Ich mag mein Aussehen, wie es ist.",
|
|
"03" = "Die meisten Menschen würden mich als gut aussehend bezeichnen.",
|
|
"04" = "Ich mag mich ohne Kleider.",
|
|
"05" = "Ich mag die Art, wie meine Kleidungsstücke sitzen.",
|
|
"06" = "Ich mag meinen Körper nicht.",
|
|
"07" = "Ich bin körperlich unattraktiv.",
|
|
"08" = "Bevor ich mich in der Öffentlichkeit zeige, prüfe ich immer, wie ich aussehe.",
|
|
"09" = "Ich achte bei neuer Kleidung immer darauf, dass sie möglichst vorteilhaft wirkt.",
|
|
"10" = "Ich prüfe mein Aussehen im Spiegel, wann immer es möglich ist.",
|
|
"11" = "Wenn ich ausgehe, brauche ich viel Zeit, um mich zurecht zu machen.",
|
|
"12" = "Es ist wichtig, dass ich immer gut aussehe.",
|
|
"13" = "Ich bin gehemmt, wenn meine Aufmachung nicht stimmt.",
|
|
"14" = "Ich gebe mir besondere Mühe mit meiner Frisur.",
|
|
"15" = "Ich versuche immer, meine körperliche Erscheinung zu verbessern.",
|
|
"16" = "Was ich gewöhnlich trage, ist praktisch, egal wie es aussieht.",
|
|
"17" = "Ich mache mir keine Gedanken darüber, was Andere über mein Aussehen denken.",
|
|
"18" = "Ich denke nie über mein Aussehen nach.",
|
|
"19" = "Ich brauche nur wenige Pflegeprodukte.",
|
|
"20" = "Ich kann leicht körperliche Fertigkeiten erlernen.",
|
|
"21" = "Ich bin geschickt.",
|
|
"22" = "Ich kümmere mich um meine Gesundheit.",
|
|
"23" = "Ich bin selten krank.",
|
|
"24" = "Ich habe das Vertrauen in meinen Körper verloren.",
|
|
"25" = "Ich bin körperlich gesund.",
|
|
"26" = "Ich würde die meisten Fitness-Tests bestehen.",
|
|
"27" = "Meine körperliche Ausdauer ist gut.",
|
|
"28" = "Mit meiner Gesundheit geht es ständig auf und ab.",
|
|
"29" = "Ich bin unsportlich.",
|
|
"30" = "Ich fühle mich oft anfällig für Krankheiten.",
|
|
"31" = "Ich kenne eine Menge Dinge, die meine Gesundheit beeinträchtigen.",
|
|
"32" = "Ich habe einen gesunden Lebensstil entwickelt.",
|
|
"33" = "Gute Gesundheit ist eines der wichtigsten Dinge in meinem Leben.",
|
|
"34" = "Ich tue nichts, was meine Gesundheit beeinträchtigen könnte.",
|
|
"35" = "Ich arbeite daran, meine körperliche Kraft zu verbessern.",
|
|
"36" = "Ich lese oft Bücher oder Zeitschriften, die sich mit Gesundheit beschäftigen.",
|
|
"37" = "Ich arbeite daran, meine körperliche Ausdauer zu verbessern.",
|
|
"38" = "Ich versuche, körperlich aktiv zu sein.",
|
|
"39" = "Ich weiß eine Menge über körperliche Fitness.",
|
|
"40" = "Körperlich fit zu sein, ist hat die erste Priorität in meinem Leben.",
|
|
"41" = "Ich führe kein regelmäßiges Fitness-Programm durch.",
|
|
"42" = "Ich halte meine Gesundheit für selbstverständlich.",
|
|
"43" = "Ich bemühe mich, eine ausgewogene und nahrhafte Diät einzuhalten.",
|
|
"44" = "Ich kümmere mich nicht darum, meine körperlichen Fähigkeiten zu verbessern."
|
|
)
|
|
FB5_SKALA = c(
|
|
"trifft nicht zu" = 1,
|
|
"trifft kaum zu" = 2,
|
|
"weder noch" = 3,
|
|
"trifft größtenteils zu" = 4,
|
|
"trifft voll zu" = 5
|
|
)
|
|
# Gegenlaeufige Items je Subskala (fliessen mit Minuszeichen in die Formel ein).
|
|
# Item 24 ist inhaltlich negativ formuliert, zaehlt aber laut Manual-Formel zum
|
|
# Plus-Block 20-27 der Subskala C - hier bewusst NICHT als gegenlaeufig markiert.
|
|
FB5_GEGENLAEUFIG = sprintf("%02d", c(6, 7, 16, 17, 18, 19, 28, 29, 30, 40, 41, 42, 43, 44))
|
|
FB5_A_BAENDER = data.frame(
|
|
min = c(7, 18, 24, 26, 30), max = c(17, 23, 25, 29, 35),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"), stringsAsFactors = FALSE)
|
|
FB5_B_BAENDER = data.frame(
|
|
min = c(12, 41, 47, 49, 54), max = c(40, 46, 48, 53, 60),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"), stringsAsFactors = FALSE)
|
|
FB5_C_BAENDER = data.frame(
|
|
min = c(11, 34, 41, 43, 48), max = c(33, 40, 42, 47, 55),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"), stringsAsFactors = FALSE)
|
|
FB5_D_BAENDER = data.frame(
|
|
min = c(14, 42, 50, 53, 60), max = c(41, 49, 52, 59, 70),
|
|
stufe = c("sehr_gering", "gering", "normal", "hoch", "sehr_hoch"), stringsAsFactors = FALSE)
|
|
|
|
SCORE_META = list(
|
|
FB1 = list(titel = "FB1 - Körperzonen-Zufriedenheit", baender = FB1_BAENDER, range = "8-40"),
|
|
FB2 = list(titel = "FB2 - Wunschtraum-Diskrepanz", baender = FB2_BAENDER, range = "0-90"),
|
|
FB3 = list(titel = "FB3 - Belastende Situationen", baender = FB3_BAENDER, range = "0-192"),
|
|
FB4_neg = list(titel = "FB4 - Negative Gedanken", baender = FB4_NEG_BAENDER, range = "0-120"),
|
|
FB4_pos = list(titel = "FB4 - Positive Gedanken", baender = FB4_POS_BAENDER, range = "0-60"),
|
|
FB5_A = list(titel = "FB5A - Beurteilung des Aussehens", baender = FB5_A_BAENDER, range = "7-35"),
|
|
FB5_B = list(titel = "FB5B - Investitionen in das Aussehen", baender = FB5_B_BAENDER, range = "12-60"),
|
|
FB5_C = list(titel = "FB5C - Beurteilung der Fitness und Gesundheit", baender = FB5_C_BAENDER, range = "11-55"),
|
|
FB5_D = list(titel = "FB5D - Investition in Fitness und Gesundheit", baender = FB5_D_BAENDER, range = "14-70")
|
|
)
|
|
SCORE_REIHENFOLGE = c("FB1", "FB2", "FB3", "FB4_neg", "FB4_pos", "FB5_A", "FB5_B", "FB5_C", "FB5_D")
|
|
|
|
|
|
# UI ####
|
|
|
|
app_css = "
|
|
body { font-family: 'Segoe UI', Helvetica, Arial, sans-serif; background: #f5f5f5; color: #222; font-size: 14px; }
|
|
|
|
.app-header {
|
|
background-color: #8B2635; color: white; padding: 15px 22px 13px;
|
|
margin-bottom: 12px; border-radius: 5px;
|
|
}
|
|
.app-header h2 { margin: 0; font-size: 1.4em; font-weight: 700; }
|
|
.app-header p { margin: 4px 0 0; font-size: 0.87em; opacity: 0.88; }
|
|
|
|
.frauen-hinweis {
|
|
background: #FFF3E0; border-left: 5px solid #E65100; color: #6D4C00;
|
|
padding: 10px 16px; border-radius: 4px; margin-bottom: 16px;
|
|
font-size: 0.9em; font-weight: 500;
|
|
}
|
|
|
|
.input-panel {
|
|
display: flex; align-items: flex-end; gap: 12px; flex-wrap: wrap;
|
|
background: white; border-radius: 6px; padding: 16px 20px;
|
|
margin-bottom: 16px; box-shadow: 0 1px 3px rgba(0,0,0,.12);
|
|
}
|
|
.input-panel .form-group { margin-bottom: 0; }
|
|
.input-panel label { font-weight: 600; color: #333; }
|
|
|
|
.btn-laden {
|
|
background-color: #8B2635 !important; border-color: #7A2030 !important;
|
|
color: white !important; font-weight: 600; padding: 6px 18px;
|
|
border-radius: 4px; letter-spacing: 0.02em; white-space: nowrap;
|
|
}
|
|
.btn-laden:hover, .btn-laden:focus {
|
|
background-color: #6E1E29 !important; border-color: #6E1E29 !important;
|
|
outline: none; box-shadow: 0 0 0 2px rgba(139,38,53,0.3) !important;
|
|
}
|
|
|
|
.alert-fehler {
|
|
background: #FFEBEE; border-left: 5px solid #C62828; color: #B71C1C;
|
|
padding: 12px 16px; border-radius: 4px; margin-bottom: 12px; font-weight: 500;
|
|
}
|
|
.alert-warnung {
|
|
background: #FFF8E1; border-left: 5px solid #E65100; color: #6D4C00;
|
|
padding: 10px 16px; border-radius: 4px; 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.1rem; 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; }
|
|
|
|
.score-zahl { font-size: 2.4rem; font-weight: 800; color: #8B2635; line-height: 1.1; }
|
|
|
|
.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: 26px; flex-shrink: 0; }
|
|
.item-text { flex: 1; color: #333; font-size: 0.92em; }
|
|
|
|
.stufe-badge {
|
|
border-radius: 4px; padding: 3px 11px; font-weight: 700;
|
|
font-size: 0.85em; white-space: nowrap; display: inline-block; margin-top: 6px;
|
|
}
|
|
.stufe-badge-sehr-gering { background: #4CAF50; color: white; }
|
|
.stufe-badge-gering { background: #F48FB1; color: #333333; }
|
|
.stufe-badge-normal { background: #EF5350; color: white; }
|
|
.stufe-badge-hoch { background: #B71C1C; color: white; }
|
|
.stufe-badge-sehr-hoch { background: #4A0000; color: white; }
|
|
|
|
.item-badge {
|
|
border-radius: 4px; padding: 2px 9px; font-weight: 700;
|
|
font-size: 0.85em; white-space: nowrap; display: inline-block;
|
|
}
|
|
.item-badge-0 { background: #4CAF50; color: white; }
|
|
.item-badge-1 { background: #F48FB1; color: #333333; }
|
|
.item-badge-2 { background: #EF5350; color: white; }
|
|
.item-badge-3 { background: #B71C1C; color: white; }
|
|
.item-badge-4 { background: #4A0000; color: white; }
|
|
.item-badge-na { background: #bbb; color: white; }
|
|
|
|
.na-hinweis { color: #999; 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("Body Image Fragebögen (FB1-FB5)"),
|
|
tags$p("Persönliches Körperbild-Profil - Einzelfall-Auswertung")
|
|
),
|
|
|
|
div(class = "frauen-hinweis", FRAUEN_HINWEIS_TEXT),
|
|
|
|
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_bodyimage_docx = function(erg) {
|
|
|
|
fp_titel = fp_text(color = AKZENT_FARBE, bold = TRUE, font.size = 18)
|
|
fp_meta = fp_text(color = "#555555", font.size = 10)
|
|
fp_hinweis = fp_text(color = "#6D4C00", italic = TRUE, font.size = 10)
|
|
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_zusatz_txt = fp_text(font.size = 10, italic = TRUE)
|
|
fp_zusatz_inf = fp_text(font.size = 9, italic = TRUE, color = "#888888")
|
|
fp_disclaimer = fp_text(font.size = 9, italic = TRUE, color = "#777777")
|
|
|
|
doc = read_docx()
|
|
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext("Body Image Fragebögen (FB1-FB5) - Auswertung", fp_titel)
|
|
))
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(paste0("Chiffre: ", erg$chiffre, " Ausfuelldatum: ", erg$datum_str,
|
|
" Erstellt: ", format(Sys.Date(), "%d.%m.%Y")), fp_meta)
|
|
))
|
|
doc = body_add_fpar(doc, fpar(ftext(FRAUEN_HINWEIS_TEXT, fp_hinweis)))
|
|
if (!is.null(erg$warnung)) {
|
|
doc = body_add_fpar(doc, fpar(ftext(paste0("Hinweis: ", erg$warnung), fp_hinweis)))
|
|
}
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
|
|
doc = body_add_fpar(doc, fpar(ftext("Summenscores", fp_abschnitt)))
|
|
for (key in SCORE_REIHENFOLGE) {
|
|
meta = SCORE_META[[key]]
|
|
wert = erg$scores[[key]]
|
|
klass = klassifiziere_stufe(wert, meta$baender)
|
|
farb_key = if (is.na(klass$stufe)) "normal" else klass$stufe
|
|
farben = STUFEN_WORD_FARBEN[[farb_key]]
|
|
wert_txt = if (!is.na(wert)) as.character(wert) else "nicht berechenbar"
|
|
doc = body_add_fpar(doc, fpar(
|
|
ftext(paste0(meta$titel, ": "), fp_label),
|
|
ftext(paste0(wert_txt, " / ", meta$range, " "), fp_normal),
|
|
ftext(paste0(" ", klass$label, " "),
|
|
fp_text(bold = TRUE, font.size = 10, color = farben$text,
|
|
shading.color = farben$bg))
|
|
))
|
|
}
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
|
|
klaerfeld_liste = Filter(Negate(is.null), lapply(erg$fb3$items[43:48], function(it) {
|
|
if (!is.null(it$klaerfeld)) paste0("FB3 Item ", it$nr, ": ", it$klaerfeld) else NULL
|
|
}))
|
|
|
|
freitext_paare = list(
|
|
list(titel = "FB1 - Andere Körperteile (Item 9)", info = erg$fb1$zusatz_09),
|
|
list(titel = "FB1 - Andere Körperteile (Item 10)", info = erg$fb1$zusatz_10),
|
|
list(titel = "FB3 - Andere schwierige Situation (Item 49)", info = erg$fb3$zusatz_49),
|
|
list(titel = "FB3 - Andere schwierige Situation (Item 50)", info = erg$fb3$zusatz_50),
|
|
list(titel = "FB4 negativ - Andere häufige negative Gedanken (Item 31)",
|
|
info = erg$fb4_neg$zusatz_31),
|
|
list(titel = "FB4 negativ - Andere häufige negative Gedanken (Item 32)",
|
|
info = erg$fb4_neg$zusatz_32),
|
|
list(titel = "FB4 positiv - Andere häufige positive Gedanken (Item 16)",
|
|
info = erg$fb4_pos$zusatz_16),
|
|
list(titel = "FB4 positiv - Andere häufige positive Gedanken (Item 17)",
|
|
info = erg$fb4_pos$zusatz_17)
|
|
)
|
|
|
|
hat_freitext = any(sapply(freitext_paare, function(x) !leer(x$info$text)))
|
|
|
|
if (length(klaerfeld_liste) > 0 || hat_freitext) {
|
|
doc = body_add_fpar(doc, fpar(ftext("Qualitative Zusatzangaben", fp_abschnitt)))
|
|
|
|
if (length(klaerfeld_liste) > 0) {
|
|
doc = body_add_fpar(doc, fpar(ftext("FB3 - Klärfelder (Items 43-48)", fp_label)))
|
|
for (kl in klaerfeld_liste) {
|
|
doc = body_add_fpar(doc, fpar(ftext(kl, fp_normal)))
|
|
}
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
}
|
|
|
|
for (fp in freitext_paare) {
|
|
if (leer(fp$info$text)) next
|
|
doc = body_add_fpar(doc, fpar(ftext(fp$titel, fp_label)))
|
|
doc = body_add_fpar(doc, fpar(ftext(fp$info$text, fp_zusatz_txt)))
|
|
if (!is.na(fp$info$rating_wert)) {
|
|
doc = body_add_fpar(doc, fpar(ftext(
|
|
paste0("Einordnung: ", fp$info$rating_text, " (", fp$info$rating_wert, ")"),
|
|
fp_text(font.size = 10, color = "#555555"))))
|
|
}
|
|
doc = body_add_fpar(doc, fpar(ftext(
|
|
"Zusätzliche qualitative Angabe, nicht im Summenscore enthalten.", fp_zusatz_inf)))
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
}
|
|
}
|
|
|
|
doc = body_add_par(doc, "", style = "Normal")
|
|
doc = body_add_fpar(doc, fpar(ftext(BODYIMAGE_DISCLAIMER, fp_disclaimer)))
|
|
|
|
doc
|
|
}
|
|
|
|
|
|
# Server ####
|
|
|
|
server = function(input, output, session) {
|
|
# --- pseudonym-support-injection v1 ---
|
|
observe({
|
|
query = parseQueryString(session$clientData$url_search)
|
|
if (!is.null(query$pseudonym) && nchar(trimws(query$pseudonym)) > 0) {
|
|
updateTextInput(session, "pseudonym", value = trimws(query$pseudonym))
|
|
}
|
|
})
|
|
|
|
observe({
|
|
query = parseQueryString(session$clientData$url_search)
|
|
if (!is.null(query$chiffre) && nchar(trimws(query$chiffre)) > 0) {
|
|
updateTextInput(session, "chiffre", value = toupper(trimws(query$chiffre)))
|
|
}
|
|
})
|
|
|
|
ergebnis_r = eventReactive(input$btn_suchen, {
|
|
|
|
chiffre = toupper(trimws(input$chiffre))
|
|
|
|
if ((nchar(trimws(input$pseudonym)) == 0 && nchar(chiffre) == 0)) {
|
|
return(list(typ = "leere_eingabe"))
|
|
}
|
|
if (!(nchar(trimws(input$pseudonym)) > 0 || grepl("^[A-Z][0-9]{6}$", chiffre))) {
|
|
return(list(typ = "format_fehler", chiffre = chiffre))
|
|
}
|
|
|
|
pfadfehler = character(0)
|
|
if (!file.exists(PFAD_DOWNLOAD_SKRIPT))
|
|
pfadfehler = c(pfadfehler,
|
|
paste0("Download-Skript nicht gefunden: >>", PFAD_DOWNLOAD_SKRIPT, "<<"))
|
|
if (!file.exists(PFAD_PSEUDONYM_SKRIPT))
|
|
pfadfehler = c(pfadfehler,
|
|
paste0("Pseudonym-Skript nicht gefunden: >>", PFAD_PSEUDONYM_SKRIPT, "<<"))
|
|
if (length(pfadfehler) > 0) {
|
|
return(list(typ = "skript_fehler",
|
|
meldung = paste("Bitte Pfade am Kopf der app.R anpassen:",
|
|
paste(pfadfehler, collapse = "\n"), sep = "\n")))
|
|
}
|
|
|
|
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)))
|
|
}
|
|
|
|
if (!exists("daten_bodyimage", envir = .GlobalEnv)) {
|
|
return(list(typ = "skript_fehler",
|
|
meldung = paste0("Objekt 'daten_bodyimage' fehlt nach dem Sourcen von:\n",
|
|
PFAD_DOWNLOAD_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 = "skript_fehler",
|
|
meldung = paste0(
|
|
"pseudonyme.db nicht gefunden.\n",
|
|
"Gesucht ausgehend vom Pseudonym-Skript-Ordner bis zu 5 Ebenen nach oben.")))
|
|
}
|
|
|
|
ok_ps = tryCatch({
|
|
alter_wd = getwd()
|
|
on.exit(setwd(alter_wd), add = TRUE)
|
|
setwd(db_ordner)
|
|
source(PFAD_PSEUDONYM_SKRIPT, local = FALSE)
|
|
if (nchar(trimws(input$pseudonym)) > 0) {
|
|
.pw_wert = trimws(input$pseudonym)
|
|
.pw_tab = get("pseudo", envir = .GlobalEnv)
|
|
.pw_treffer = .pw_tab[.pw_tab$pseudonym == .pw_wert, ]
|
|
if (nrow(.pw_treffer) > 0) chiffre = toupper(trimws(.pw_treffer$chiffre[1]))
|
|
}
|
|
list(ok = TRUE)
|
|
}, error = function(e) list(ok = FALSE, msg = e$message))
|
|
if (!ok_ps$ok) {
|
|
return(list(typ = "skript_fehler",
|
|
meldung = paste0("Fehler im Pseudonym-Skript: ", ok_ps$msg)))
|
|
}
|
|
|
|
if (!exists("pseudo", envir = .GlobalEnv)) {
|
|
return(list(typ = "skript_fehler",
|
|
meldung = paste0("Objekt 'pseudo' fehlt nach dem Sourcen von:\n",
|
|
PFAD_PSEUDONYM_SKRIPT)))
|
|
}
|
|
|
|
daten = get("daten_bodyimage", envir = .GlobalEnv)
|
|
dat_ps = get("pseudo", envir = .GlobalEnv)
|
|
|
|
ps_treffer = dat_ps[tolower(trimws(dat_ps$chiffre)) == tolower(chiffre), , drop = FALSE]
|
|
if (nrow(ps_treffer) == 0) {
|
|
return(list(typ = "chiffre_nicht_gefunden", chiffre = chiffre))
|
|
}
|
|
|
|
alle_session_ids = unique(as.character(ps_treffer$pseudonym))
|
|
if (nchar(trimws(input$pseudonym)) > 0) alle_session_ids = trimws(input$pseudonym)
|
|
|
|
if (!("session" %in% names(daten))) {
|
|
return(list(typ = "skript_fehler",
|
|
meldung = paste0(
|
|
"Erwartete Spalte 'session' fehlt in 'daten_bodyimage'. ",
|
|
"Bitte Struktur des Download-Skripts pruefen - ",
|
|
"vorhandene Spalten: ", paste(names(daten), collapse = ", "))))
|
|
}
|
|
|
|
treffer = daten[daten$session %in% alle_session_ids, , drop = FALSE]
|
|
if (nrow(treffer) == 0) {
|
|
return(list(typ = "session_nicht_gefunden", chiffre = chiffre,
|
|
session_id = paste(alle_session_ids, collapse = ", ")))
|
|
}
|
|
|
|
warnung = NULL
|
|
if (nrow(treffer) > 1) {
|
|
if ("created" %in% names(treffer)) {
|
|
created_vals = as.POSIXct(treffer$created, tz = "UTC")
|
|
neueste_idx = which.max(created_vals)
|
|
datum_neu = format(created_vals[neueste_idx], "%d.%m.%Y %H:%M")
|
|
warnung = paste0("Mehrere Ausfuellungen gefunden (", nrow(treffer), "). ",
|
|
"Angezeigt wird die neueste vom ", datum_neu, ".")
|
|
treffer = treffer[neueste_idx, , drop = FALSE]
|
|
} else {
|
|
warnung = paste0("Mehrere Ausfuellungen gefunden (", nrow(treffer), "). ",
|
|
"Angezeigt wird der erste Eintrag (keine 'created'-Spalte vorhanden).")
|
|
treffer = treffer[1, , drop = FALSE]
|
|
}
|
|
}
|
|
|
|
zeile = treffer[1, , drop = FALSE]
|
|
datum_str = if ("created" %in% names(zeile) && !is.na(zeile$created[1])) {
|
|
tryCatch(format(as.POSIXct(zeile$created[1], tz = "UTC"), "%d.%m.%Y"),
|
|
error = function(e) format(Sys.Date(), "%d.%m.%Y"))
|
|
} else format(Sys.Date(), "%d.%m.%Y")
|
|
|
|
warn_env = new.env()
|
|
assign("liste", character(0), envir = warn_env)
|
|
|
|
fb1 = berechne_fb1(zeile, daten, warn_env)
|
|
fb2 = berechne_fb2(zeile, daten, warn_env)
|
|
fb3 = berechne_fb3(zeile, daten, warn_env)
|
|
fb4_neg = berechne_fb4_neg(zeile, daten, warn_env)
|
|
fb4_pos = berechne_fb4_pos(zeile, daten, warn_env)
|
|
fb5 = berechne_fb5(zeile, daten, warn_env)
|
|
|
|
scores = list(
|
|
FB1 = fb1$score, FB2 = fb2$score, FB3 = fb3$score,
|
|
FB4_neg = fb4_neg$score, FB4_pos = fb4_pos$score,
|
|
FB5_A = fb5$A, FB5_B = fb5$B, FB5_C = fb5$C, FB5_D = fb5$D
|
|
)
|
|
|
|
list(
|
|
typ = "ergebnis",
|
|
chiffre = chiffre,
|
|
datum_str = datum_str,
|
|
warnung = warnung,
|
|
item_warnungen = get("liste", envir = warn_env),
|
|
fb1 = fb1, fb2 = fb2, fb3 = fb3, fb4_neg = fb4_neg, fb4_pos = fb4_pos, fb5 = fb5,
|
|
scores = scores
|
|
)
|
|
})
|
|
|
|
|
|
output$fehler_ui = renderUI({
|
|
req(input$btn_suchen)
|
|
erg = ergebnis_r()
|
|
|
|
if (erg$typ == "leere_eingabe") {
|
|
return(div(class = "alert-fehler", "Bitte eine Patientenchiffre eingeben."))
|
|
}
|
|
if (erg$typ == "format_fehler") {
|
|
return(div(class = "alert-fehler",
|
|
"Ungültige Chiffre \"", erg$chiffre, "\". Erwartet wird ein Großbuchstabe ",
|
|
"gefolgt von 6 Ziffern, z.B. P000123."))
|
|
}
|
|
if (erg$typ == "skript_fehler") {
|
|
return(div(class = "alert-fehler",
|
|
tags$strong("Konfigurationsfehler: "),
|
|
tags$pre(style = "white-space:pre-wrap; font-size:0.88em; margin:6px 0 0;",
|
|
erg$meldung)))
|
|
}
|
|
if (erg$typ == "chiffre_nicht_gefunden") {
|
|
return(div(class = "alert-fehler",
|
|
"Chiffre \"", erg$chiffre, "\" wurde in der Pseudonym-Datenbank nicht gefunden."))
|
|
}
|
|
if (erg$typ == "session_nicht_gefunden") {
|
|
return(div(class = "alert-fehler",
|
|
"Kein Body-Image-Datensatz fuer Chiffre \"", erg$chiffre, "\" gefunden ",
|
|
"(", erg$session_id, ")."))
|
|
}
|
|
NULL
|
|
})
|
|
|
|
output$warnung_ui = renderUI({
|
|
req(input$btn_suchen)
|
|
erg = ergebnis_r()
|
|
if (erg$typ != "ergebnis") return(NULL)
|
|
tagList(
|
|
if (!is.null(erg$warnung)) div(class = "alert-warnung", erg$warnung),
|
|
if (length(erg$item_warnungen) > 0)
|
|
div(class = "alert-warnung",
|
|
tags$strong("Datenqualitaets-Hinweis: "),
|
|
tags$ul(lapply(erg$item_warnungen, tags$li))
|
|
)
|
|
)
|
|
})
|
|
|
|
output$ergebnis_ui = renderUI({
|
|
req(input$btn_suchen)
|
|
erg = ergebnis_r()
|
|
if (erg$typ != "ergebnis") return(NULL)
|
|
|
|
kopf_block = div(class = "abschnitt-karte",
|
|
div(class = "meta-block",
|
|
tags$strong("Chiffre: "), erg$chiffre,
|
|
tags$span(" | ", style = "color:#ccc;"),
|
|
tags$strong("Ausfülldatum: "), erg$datum_str
|
|
)
|
|
)
|
|
|
|
fb1_zusatz = list()
|
|
if (!leer(erg$fb1$zusatz_09$text))
|
|
fb1_zusatz[[length(fb1_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere Körperteile, die Sie nicht mögen (Item 9)",
|
|
erg$fb1$zusatz_09$text, erg$fb1$zusatz_09$rating_text, erg$fb1$zusatz_09$rating_wert)
|
|
if (!leer(erg$fb1$zusatz_10$text))
|
|
fb1_zusatz[[length(fb1_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere Körperteile, die Sie nicht mögen (Item 10)",
|
|
erg$fb1$zusatz_10$text, erg$fb1$zusatz_10$rating_text, erg$fb1$zusatz_10$rating_wert)
|
|
|
|
fb1_karte = baue_score_karte("FB1", erg$scores$FB1, "gauge_FB1",
|
|
lapply(sortiere_nach_wert(erg$fb1$items, "wert"),
|
|
function(it) item_zeile_ui(it$nr, it$text, it$antwort, it$wert, it$badge)),
|
|
fb1_zusatz)
|
|
|
|
fb2_karte = baue_score_karte("FB2", erg$scores$FB2, "gauge_FB2",
|
|
lapply(sortiere_nach_wert(erg$fb2$items, "produkt"), fb2_item_zeile_ui))
|
|
|
|
fb3_items_ui = lapply(sortiere_nach_wert(erg$fb3$items, "wert"), function(it) {
|
|
zusatz = if (!is.null(it$klaerfeld))
|
|
tags$div(style = "color:#888; font-size:0.85em; margin-top:2px;",
|
|
paste0("(", FB3_KLAERFELD_LABEL[[it$nr]], " ", it$klaerfeld, ")"))
|
|
else NULL
|
|
item_zeile_ui(it$nr, it$text, it$antwort, it$wert, it$badge, zusatz)
|
|
})
|
|
fb3_zusatz = list()
|
|
if (!leer(erg$fb3$zusatz_49$text))
|
|
fb3_zusatz[[length(fb3_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere schwierige Situation (Item 49)",
|
|
erg$fb3$zusatz_49$text, erg$fb3$zusatz_49$rating_text, erg$fb3$zusatz_49$rating_wert)
|
|
if (!leer(erg$fb3$zusatz_50$text))
|
|
fb3_zusatz[[length(fb3_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere schwierige Situation (Item 50)",
|
|
erg$fb3$zusatz_50$text, erg$fb3$zusatz_50$rating_text, erg$fb3$zusatz_50$rating_wert)
|
|
fb3_karte = baue_score_karte("FB3", erg$scores$FB3, "gauge_FB3", fb3_items_ui, fb3_zusatz)
|
|
|
|
fb4_neg_zusatz = list()
|
|
if (!leer(erg$fb4_neg$zusatz_31$text))
|
|
fb4_neg_zusatz[[length(fb4_neg_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere häufige negative Gedanken (Item 31)",
|
|
erg$fb4_neg$zusatz_31$text, erg$fb4_neg$zusatz_31$rating_text, erg$fb4_neg$zusatz_31$rating_wert)
|
|
if (!leer(erg$fb4_neg$zusatz_32$text))
|
|
fb4_neg_zusatz[[length(fb4_neg_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere häufige negative Gedanken (Item 32)",
|
|
erg$fb4_neg$zusatz_32$text, erg$fb4_neg$zusatz_32$rating_text, erg$fb4_neg$zusatz_32$rating_wert)
|
|
fb4_neg_karte = baue_score_karte("FB4_neg", erg$scores$FB4_neg, "gauge_FB4_neg",
|
|
lapply(sortiere_nach_wert(erg$fb4_neg$items, "wert"),
|
|
function(it) item_zeile_ui(it$nr, it$text, it$antwort, it$wert, it$badge)),
|
|
fb4_neg_zusatz)
|
|
|
|
fb4_pos_zusatz = list()
|
|
if (!leer(erg$fb4_pos$zusatz_16$text))
|
|
fb4_pos_zusatz[[length(fb4_pos_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere häufige positive Gedanken (Item 16)",
|
|
erg$fb4_pos$zusatz_16$text, erg$fb4_pos$zusatz_16$rating_text, erg$fb4_pos$zusatz_16$rating_wert)
|
|
if (!leer(erg$fb4_pos$zusatz_17$text))
|
|
fb4_pos_zusatz[[length(fb4_pos_zusatz) + 1]] = freitext_block_ui(
|
|
"Andere häufige positive Gedanken (Item 17)",
|
|
erg$fb4_pos$zusatz_17$text, erg$fb4_pos$zusatz_17$rating_text, erg$fb4_pos$zusatz_17$rating_wert)
|
|
fb4_pos_karte = baue_score_karte("FB4_pos", erg$scores$FB4_pos, "gauge_FB4_pos",
|
|
lapply(sortiere_nach_wert(erg$fb4_pos$items, "wert"),
|
|
function(it) item_zeile_ui(it$nr, it$text, it$antwort, it$wert, it$badge)),
|
|
fb4_pos_zusatz)
|
|
|
|
fb5_item_row = function(it) {
|
|
zusatz = if (it$nr %in% FB5_GEGENLAEUFIG)
|
|
tags$span(style = "color:#888; font-size:0.82em; font-style:italic; margin-left:6px;",
|
|
"(gegenläufig)")
|
|
else NULL
|
|
item_zeile_ui(it$nr, it$text, it$antwort, it$wert, it$badge, zusatz)
|
|
}
|
|
fb5_items_bereich = function(von, bis) {
|
|
idx = sprintf("%02d", von:bis)
|
|
auswahl = erg$fb5$items[sapply(erg$fb5$items, `[[`, "nr") %in% idx]
|
|
lapply(sortiere_nach_wert(auswahl, "wert"), fb5_item_row)
|
|
}
|
|
|
|
fb5_a_karte = baue_score_karte("FB5_A", erg$scores$FB5_A, "gauge_FB5_A", fb5_items_bereich(1, 7))
|
|
fb5_b_karte = baue_score_karte("FB5_B", erg$scores$FB5_B, "gauge_FB5_B", fb5_items_bereich(8, 19))
|
|
fb5_c_karte = baue_score_karte("FB5_C", erg$scores$FB5_C, "gauge_FB5_C", fb5_items_bereich(20, 30))
|
|
fb5_d_karte = baue_score_karte("FB5_D", erg$scores$FB5_D, "gauge_FB5_D", fb5_items_bereich(31, 44))
|
|
|
|
tagList(
|
|
kopf_block, fb1_karte, fb2_karte, fb3_karte,
|
|
fb4_neg_karte, fb4_pos_karte,
|
|
fb5_a_karte, fb5_b_karte, fb5_c_karte, fb5_d_karte
|
|
)
|
|
})
|
|
|
|
observe({
|
|
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
|
if (is.null(erg) || erg$typ != "ergebnis") return()
|
|
for (key in SCORE_REIHENFOLGE) {
|
|
local({
|
|
key_ = key
|
|
meta_ = SCORE_META[[key_]]
|
|
wert_ = erg$scores[[key_]]
|
|
output[[paste0("gauge_", key_)]] = renderPlot({
|
|
make_gauge(wert_, meta_$baender, AKZENT_FARBE, paste0(meta_$titel, " (", meta_$range, ")"))
|
|
}, bg = "white", res = 144)
|
|
})
|
|
}
|
|
})
|
|
|
|
output$download_word = downloadHandler(
|
|
filename = function() {
|
|
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
|
if (is.null(erg) || erg$typ != "ergebnis") return("Bodyimage_Export.docx")
|
|
chiffre_esc = gsub("[^A-Za-z0-9_-]", "_", erg$chiffre)
|
|
datum_fn = tryCatch(format(as.Date(erg$datum_str, "%d.%m.%Y"), "%Y%m%d"),
|
|
error = function(e) format(Sys.Date(), "%Y%m%d"))
|
|
paste0("Bodyimage_", chiffre_esc, "_", datum_fn, ".docx")
|
|
},
|
|
content = function(file) {
|
|
erg = tryCatch(ergebnis_r(), error = function(e) NULL)
|
|
if (is.null(erg) || erg$typ != "ergebnis") {
|
|
doc = read_docx()
|
|
doc = body_add_par(doc,
|
|
"Kein Datensatz geladen. Bitte zuerst Chiffre eingeben und 'Auswerten' klicken.",
|
|
style = "Normal")
|
|
print(doc, target = file)
|
|
return()
|
|
}
|
|
doc = erstelle_bodyimage_docx(erg)
|
|
print(doc, target = file)
|
|
}
|
|
)
|
|
|
|
}
|
|
|
|
|
|
# Start ####
|
|
|
|
shinyApp(ui = ui, server = server)
|