add homekeeper stack

This commit is contained in:
2026-07-06 19:25:38 +02:00
commit 58983e6855
90 changed files with 6816 additions and 0 deletions
+255
View File
@@ -0,0 +1,255 @@
INSP_INFO <- list(
futtervorrat = list(
title = "Futtervorrat schätzen",
content = shiny::tagList(
shiny::tags$p("Zarge wiegen und Leergewicht abziehen."),
shiny::tags$p(shiny::tags$strong("Richtwerte Leergewicht (Holz):")),
shiny::tags$table(class = "table table-sm table-borderless mb-0",
shiny::tags$tbody(
shiny::tags$tr(shiny::tags$td("Zander Honigraum"), shiny::tags$td("ca. 56 kg")),
shiny::tags$tr(shiny::tags$td("Zander Brutraum"), shiny::tags$td("ca. 78 kg")),
shiny::tags$tr(shiny::tags$td("Dadant Brutraum"), shiny::tags$td("ca. 810 kg"))
)
),
shiny::tags$p(class = "mt-2 mb-0", "1 voll verdeckelter Rahmen ≈ 23 kg."),
shiny::tags$p(class = "mb-0 text-muted small", "Winterbedarf: ca. 1520 kg / Volk.")
)
),
sanftmut = list(
title = "Sanftmut (14)",
content = shiny::tagList(
shiny::tags$p(class = "mb-1", "Verhalten während der Durchsicht", shiny::tags$em("(niedriger = besser):")),
shiny::tags$table(class = "table table-sm table-borderless mb-0",
shiny::tags$tbody(
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("sehr sanft kein Stichversuch")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("sanft vereinzelte Stichversuche")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("unruhig mehrere Stichversuche")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("aggressiv folgt dem Imker"))
)
)
)
),
schwarmtrieb = list(
title = "Schwarmtrieb (14)",
content = shiny::tagList(
shiny::tags$p(class = "mb-1", "Neigung zur Schwarmbildung", shiny::tags$em("(niedriger = besser):")),
shiny::tags$table(class = "table table-sm table-borderless mb-0",
shiny::tags$tbody(
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("kein Schwarmtrieb")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("gering vereinzelte Zellen")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("erhöht mehrere Zellen")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("stark Schwarm unmittelbar"))
)
)
)
),
wabensitz = list(
title = "Wabensitz (14)",
content = shiny::tagList(
shiny::tags$p(class = "mb-1", "Ruhigkeit auf der Wabe", shiny::tags$em("(niedriger = besser):")),
shiny::tags$table(class = "table table-sm table-borderless mb-0",
shiny::tags$tbody(
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("sehr ruhig Bienen sitzen fest")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("leicht unruhig")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("unruhig Traubenbildung")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("sehr unruhig starkes Laufen"))
)
)
)
),
honigertrag = list(
title = "Honigertrag (14)",
content = shiny::tagList(
shiny::tags$p(class = "mb-1", "Honigleistung relativ zur Standpopulation", shiny::tags$em("(niedriger = besser):")),
shiny::tags$table(class = "table table-sm table-borderless mb-0",
shiny::tags$tbody(
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("überdurchschnittlich")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("durchschnittlich")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("unterdurchschnittlich")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("sehr gering"))
)
)
)
),
varroa = list(
title = "Varroa-Hygiene (14)",
content = shiny::tagList(
shiny::tags$p(class = "mb-1", "VSH-Verhalten (Varroa Sensitive Hygiene)", shiny::tags$em("(niedriger = besser):")),
shiny::tags$table(class = "table table-sm table-borderless mb-0",
shiny::tags$tbody(
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("1")), shiny::tags$td("sehr stark räumt Varroazellen aus")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("2")), shiny::tags$td("erkennbar")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("3")), shiny::tags$td("schwach erkennbar")),
shiny::tags$tr(shiny::tags$td(shiny::tags$strong("4")), shiny::tags$td("nicht erkennbar"))
)
),
shiny::tags$p(class = "mt-2 mb-0 text-muted small", "Tipp: Alkoholwäsche gibt verlässlichere Werte.")
)
)
)
screen_inspection_ui <- function(id) {
ns <- NS(id)
shiny::div(
section_card(NULL,
shiny::div(class = "row g-2 py-2",
shiny::div(class = "col-6",
shiny::dateInput(ns("date"), "Datum", value = Sys.Date(), language = "de", weekstart = 1)
),
shiny::div(class = "col-6",
shiny::textInput(ns("inspector"), "Imker/in")
)
)
),
section_card("Stockkarte",
stepper_row(ns, "brood", "Brutwaben"),
stepper_row(ns, "honey", "Honigwaben"),
strength_row(ns),
shiny::div(
class = "d-flex justify-content-between align-items-center py-3 border-bottom",
shiny::span(class = "fw-semibold",
"Futtervorrat (kg)",
info_icon(INSP_INFO$futtervorrat$title, INSP_INFO$futtervorrat$content)
),
shiny::numericInput(ns("food_kg"), NULL, value = NA, min = 0, step = 0.5, width = "100px")
)
),
section_card("Königin",
toggle_row(ns, "queen_seen", "Königin gesehen"),
toggle_row(ns, "eggs_seen", "Eier / Stifte gesehen"),
stepper_row(ns, "qcells", "Weiselzellen")
),
section_card(NULL,
shiny::div(class = "py-2",
shiny::div(class = "d-flex justify-content-between align-items-center mb-1",
shiny::tags$label("Notizen / Auffälligkeiten", class = "form-label mb-0"),
shiny::div(class = "d-flex align-items-center gap-2",
shiny::tags$small(id = ns("mic_status"), class = "text-muted", ""),
shiny::tags$button(
id = ns("mic_btn"),
type = "button",
class = "btn btn-outline-secondary btn-sm",
title = "Spracheingabe (Deutsch)",
"\U0001f3a4"
)
)
),
shiny::textAreaInput(ns("notes"), NULL, rows = 3, width = "100%"),
shiny::tags$script(shiny::HTML(sprintf('
setTimeout(function() {
var SR = window.SpeechRecognition || window.webkitSpeechRecognition;
var btn = document.getElementById("%s");
var sts = document.getElementById("%s");
if (!SR) { if (btn) btn.style.display = "none"; return; }
var rec = null;
var active = false;
function setIdle() {
active = false;
btn.classList.replace("btn-danger", "btn-outline-secondary");
btn.textContent = "\U0001f3a4";
sts.textContent = "";
}
function setRecording() {
active = true;
btn.classList.replace("btn-outline-secondary", "btn-danger");
btn.textContent = "⏹";
sts.textContent = "Aufnahme...";
}
btn.addEventListener("click", function() {
if (active) {
rec.stop();
} else {
rec = new SR();
rec.lang = "de-DE";
rec.continuous = false;
rec.interimResults = false;
rec.onstart = function() { setRecording(); };
rec.onresult = function(e) {
var t = Array.from(e.results)
.filter(function(r) { return r.isFinal; })
.map(function(r) { return r[0].transcript; })
.join(" ").trim();
if (!t) return;
var ta = document.getElementById("%s");
ta.value = ta.value ? ta.value + " " + t : t;
Shiny.setInputValue("%s", ta.value, {priority: "event"});
};
rec.onerror = function(e) {
sts.textContent = "Fehler: " + e.error;
setTimeout(setIdle, 2000);
};
rec.onend = function() { setIdle(); };
rec.start();
}
});
}, 200);
', ns("mic_btn"), ns("mic_status"), ns("notes"), ns("notes"))))
)
),
collapsible_card("Zuchteigenschaften (optional)",
trait_row(ns, "t_sanft", "Sanftmut", info = INSP_INFO$sanftmut),
trait_row(ns, "t_schwarm", "Schwarmtrieb", info = INSP_INFO$schwarmtrieb),
trait_row(ns, "t_waben", "Wabensitz", info = INSP_INFO$wabensitz),
trait_row(ns, "t_honig", "Honigertrag", info = INSP_INFO$honigertrag),
trait_row(ns, "t_varroa", "Varroa-Hygiene", info = INSP_INFO$varroa),
collapse_id = "insp_zuchteig"
),
shiny::div(class = "d-grid mt-2 mb-5",
shiny::actionButton(ns("save"), "Durchsicht speichern",
class = "btn btn-primary btn-lg")
)
)
}
screen_inspection_server <- function(id, db, nav) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
brood <- stepper_server("brood", input, output)
honey <- stepper_server("honey", input, output)
qcells <- stepper_server("qcells", input, output, default = 0L)
str_v <- strength_server("strength", ns, input, output)
t_sanft <- trait_server("t_sanft", ns, input, output)
t_schwarm <- trait_server("t_schwarm", ns, input, output)
t_waben <- trait_server("t_waben", ns, input, output)
t_honig <- trait_server("t_honig", ns, input, output)
t_varroa <- trait_server("t_varroa", ns, input, output)
observeEvent(nav$screen, {
if (nav$screen == "inspection") {
brood(NA_integer_); honey(NA_integer_); qcells(0L); str_v(NA_integer_)
t_sanft(NA_integer_); t_schwarm(NA_integer_); t_waben(NA_integer_)
t_honig(NA_integer_); t_varroa(NA_integer_)
}
}, ignoreInit = TRUE)
observeEvent(input$save, {
req(nav$colony_id)
db_inspections_insert(db,
colony_id = nav$colony_id,
date = input$date,
inspector = input$inspector,
brood_frames = brood(),
honey_frames = honey(),
food_stores_kg = input$food_kg,
colony_strength = str_v(),
queen_seen = isTRUE(input$queen_seen),
eggs_seen = isTRUE(input$eggs_seen),
queen_cells_count = qcells() %||% 0L,
notes = input$notes,
traits = list(
sanftmut = t_sanft(),
schwarmtrieb = t_schwarm(),
wabensitz = t_waben(),
honigertrag = t_honig(),
varroa_hygiene = t_varroa()
)
)
nav$screen <- "colony"
})
})
}