Skip to content

Close #50 #51

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
tomaszaba merged 4 commits into from
Jul 31, 2026
Merged

Close #50 #51

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
a64e3ba
rename 'Screening' to 'Screening & Sentinel Site'
tomaszaba Jul 31, 2026
db0c5aa
update user guide
tomaszaba Jul 31, 2026
8eb43aa
Close #50
tomaszaba Jul 31, 2026
57d9da9
Merge branch 'dev' into update-ui
tomaszaba Jul 31, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
109 changes: 81 additions & 28 deletions R/module-prevalence.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,20 +24,22 @@ module_ui_prevalence <- function(id) {
style = "background-color: #f9fdfb;",
style = "width: 350px;",
bslib::card_header(
htmltools::tags$span("Define Analysis Parameters",
htmltools::tags$span(
"Define Analysis Parameters",
style = "font-size: 15px; font-weight: bold;"
)
),

#### Select the source of data for prevalence analysis ----
shiny::radioButtons(
inputId = ns("source"),
label = htmltools::tags$span("Select Data Source",
label = htmltools::tags$span(
"Select Data Source",
style = "font-size: 14px; font-weight: bold;"
),
choices = list(
"Survey" = "survey",
"Screening" = "screening"
"Screening & Sentinel Site" = "screening"
),
selected = "survey",
inline = TRUE
Expand Down Expand Up @@ -65,7 +67,8 @@ module_ui_prevalence <- function(id) {
bslib::card(
style = "background-color: #f9fdfb;",
bslib::card_header(
htmltools::tags$span("Prevalence Analysis Results",
htmltools::tags$span(
"Prevalence Analysis Results",
style = "font-size: 15px; font-weight: bold;"
)
),
Expand All @@ -79,10 +82,12 @@ module_ui_prevalence <- function(id) {
image.height = "50px",
color = "#004225",
caption = htmltools::tags$div(
htmltools::tags$h6(htmltools::tags$span("Estimating prevalence",
htmltools::tags$h6(htmltools::tags$span(
"Estimating prevalence",
style = "font-size: 12px;"
)),
htmltools::tags$h6(htmltools::tags$span("Please wait...",
htmltools::tags$h6(htmltools::tags$span(
"Please wait...",
style = "font-size: 12px;"
))
)
Expand All @@ -97,7 +102,6 @@ module_ui_prevalence <- function(id) {

## ---- Module: Server ---------------------------------------------------------


#'
#'
#' Module server for prevalence analysis
Expand All @@ -118,13 +122,15 @@ module_server_prevalence <- function(id, data) {
### Render the method through which GAM should be estimated ----
output$amnby <- shiny::renderUI({
#### Display method options ----
switch(input$source,
switch(
input$source,

##### Options for survey data ----
"survey" = {
shiny::radioButtons(
inputId = ns("amn_method_survey"),
label = htmltools::tags$span("Acute malnutrition based on:",
label = htmltools::tags$span(
"Acute malnutrition based on:",
style = "font-size: 14px; font-weight: bold;"
),
choices = list(
Expand All @@ -141,7 +147,8 @@ module_server_prevalence <- function(id, data) {
"screening" = {
shiny::radioButtons(
inputId = ns("has_age"),
label = htmltools::tags$span("Is age in months available?",
label = htmltools::tags$span(
"Is age in months available?",
style = "font-size: 14px; font-weight: bold;"
),
choices = list("Yes" = "yes", "No" = "no"),
Expand All @@ -159,7 +166,11 @@ module_server_prevalence <- function(id, data) {

#### Display variables ----
mod_prevalence_display_input_variables(
vars, input$source, input$amn_method_survey, input$has_age, ns
vars,
input$source,
input$amn_method_survey,
input$has_age,
ns
)
})

Expand Down Expand Up @@ -196,7 +207,8 @@ module_server_prevalence <- function(id, data) {
tryCatch(
{
p <- if (input$source == "survey") {
switch(input$amn_method_survey,
switch(
input$amn_method_survey,
"wfhz" = {
mod_prevalence_call_wfhz_prev_estimator(
df = data(),
Expand All @@ -205,11 +217,14 @@ module_server_prevalence <- function(id, data) {
area1 = input$area1,
area2 = input$area2,
area3 = input$area3
) |> mod_prevalence_neat_output_survey(.type = "wfhz")
) |>
mod_prevalence_neat_output_survey(.type = "wfhz")
},
"muac" = {
data() |>
dplyr::mutate(muac = mwana::recode_muac(!!rlang::sym(input$muac), "mm")) |>
dplyr::mutate(
muac = mwana::recode_muac(!!rlang::sym(input$muac), "mm")
) |>
mod_prevalence_call_muac_prev_estimator(
age = input$age,
muac = input$muac,
Expand All @@ -223,7 +238,9 @@ module_server_prevalence <- function(id, data) {
},
"combined" = {
data() |>
dplyr::mutate(muac = mwana::recode_muac(.data$muac, "mm")) |>
dplyr::mutate(
muac = mwana::recode_muac(.data$muac, "mm")
) |>
mod_prevalence_call_combined_prev_estimator(
wts = input$wts,
oedema = input$oedema,
Expand All @@ -235,7 +252,8 @@ module_server_prevalence <- function(id, data) {
}
)
} else {
switch(input$has_age,
switch(
input$has_age,
"yes" = {
shiny::req(input$muac, input$age)
mod_prevalence_call_prev_estimator_screening(
Expand Down Expand Up @@ -271,7 +289,8 @@ module_server_prevalence <- function(id, data) {
},
error = function(e) {
shiny::showNotification(
ui = paste("Error while estimating:", e$message), type = "error"
ui = paste("Error while estimating:", e$message),
type = "error"
)
}
)
Expand All @@ -294,16 +313,20 @@ module_server_prevalence <- function(id, data) {
),
caption = if (nrow(prevalence$estimated) > 20) {
paste(
"Showing first 20 rows of", format(nrow(prevalence$estimated), big.mark = "."),
"Showing first 20 rows of",
format(nrow(prevalence$estimated), big.mark = "."),
"total rows"
)
} else {
paste("Showing all", nrow(prevalence$estimated), "rows")
}
) |> DT::formatStyle(columns = colnames(prevalence$estimated), fontSize = "13px")
) |>
DT::formatStyle(
columns = colnames(prevalence$estimated),
fontSize = "13px"
)
})


#### Download button to download table of detected clusters in .xlsx ----
##### Output into the UI ----
output$download_prevalence <- shiny::renderUI({
Expand All @@ -320,23 +343,47 @@ module_server_prevalence <- function(id, data) {
)
})


##### Downloadable results by clicking on the download button ----
output$download_results <- shiny::downloadHandler(
filename = function() {
if (input$source == "survey") {
if (input$amn_method_survey == "wfhz") {
paste0("mwana-amn-prevalence-survey-wfhz_", Sys.Date(), ".xlsx", sep = "")
paste0(
"mwana-amn-prevalence-survey-wfhz_",
Sys.Date(),
".xlsx",
sep = ""
)
} else if (input$amn_method_survey == "muac") {
paste0("mwana-amn-prevalence-survey-muac_", Sys.Date(), ".xlsx", sep = "")
paste0(
"mwana-amn-prevalence-survey-muac_",
Sys.Date(),
".xlsx",
sep = ""
)
} else {
paste0("mwana-amn-prevalence-survey-combined_", Sys.Date(), ".xlsx", sep = "")
paste0(
"mwana-amn-prevalence-survey-combined_",
Sys.Date(),
".xlsx",
sep = ""
)
}
} else {
if (input$has_age == "yes") {
paste0("mwana-amn-prevalence-screening-age-avail_", Sys.Date(), ".xlsx", sep = "")
paste0(
"mwana-amn-prevalence-screening-age-avail_",
Sys.Date(),
".xlsx",
sep = ""
)
} else {
paste0("mwana-amn-prevalence-screening-age-notavail_", Sys.Date(), ".xlsx", sep = "")
paste0(
"mwana-amn-prevalence-screening-age-notavail_",
Sys.Date(),
".xlsx",
sep = ""
)
}
}
},
Expand All @@ -345,10 +392,16 @@ module_server_prevalence <- function(id, data) {
tryCatch(
{
openxlsx::write.xlsx(prevalence$estimated, file)
shiny::showNotification("File downloaded successfully!", type = "message")
shiny::showNotification(
"File downloaded successfully!",
type = "message"
)
},
error = function(e) {
shiny::showNotification(paste("Error creating file:", e$message), type = "error")
shiny::showNotification(
paste("Error creating file:", e$message),
type = "error"
)
}
)
}
Expand Down
47 changes: 38 additions & 9 deletions inst/app/ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,7 @@ ui <- tagList(
"
This app is a lightweight, field-ready application
thoughtful designed to seamlessly streamline plausibility checks
and wasting prevalence estimation of child anthropometric data,
and wasting prevalence estimation of child anthropometric data
by automating key steps of the R package
",
tags$a(
Expand All @@ -131,7 +131,7 @@ ui <- tagList(
"for non-R users."
),
tags$p(
"The app is divided in five easy-to-navigate tabs, apart from
"The app is divided into five easy-to-navigate tabs, apart from
the Home - where you at right now.",
tags$ol(
tags$li(tags$b("Data Upload")),
Expand All @@ -156,7 +156,7 @@ ui <- tagList(
dataset saved in a comma-separated-value format (.csv); this is
the only accepted format. Click on the 'Browse' button to locate
the file to be uploaded from your computer; it is as simple as that.
Once uploaded, the first 20 rows will be priviewed on the right side.
Once uploaded, the first 20 rows will be priviewed on the right side of the tab.
"
),
tags$ul(
Expand All @@ -165,7 +165,7 @@ ui <- tagList(
tags$p(
"
The data to be uploaded must have been tidy up in accordance
to the below-described app's",
to the below-described app ",
tags$b("input file"),
"and",
tags$b("input variable"),
Expand All @@ -180,7 +180,7 @@ ui <- tagList(
tags$b("File naming:"),
"the file name must use
underscore ( _ ) to separate words. Hyphen ( - ) or
simple spaces will lead to errors along the uploading
simple spaces could lead to errors along the uploading
process. Consider the following naming example:",
tags$em("my_file_to_upload.csv")
)
Expand All @@ -190,6 +190,23 @@ ui <- tagList(
tags$li(
tags$b("Input variable requirements"),
tags$ul(
tags$li(
tags$b("Date of data collection:"),
"this is an optional variable. If provided, it is
used to calculate the child’s age in months.
The date format should be DD/MM/YYYY (e.g., 16/07/2023).
Variable names may follow any format. For longer names,
separate words with an underscore (e.g., survey_date)."
),
tags$li(
tags$b("Date of birth:"),
"this is an optional variable. If provided, it is
used to calculate the child’s age in months.
The date format should be DD/MM/YYYY (e.g., 16/07/2023).
Variable names may follow any format. For longer names,
separate words with an underscore (e.g., birth_date).
"
),
tags$li(
tags$b("Age:"),
"values must be in months. The variable name
Expand All @@ -200,17 +217,29 @@ ui <- tagList(
"values must be given in 'm' for boys and 'f'
for girls."
),
tags$li(
tags$b("Weight"),
"child's weight in kilograms. The variable name must
be written in lowercase ('weight')."
),
tags$li(
tags$b("Height"),
"child's height in centimetres. The variable name must
be written in lowercase ('height')."
),
tags$li(
tags$b("MUAC:"),
"values must be in millimetres. Ensure there
are no strange numbers, such as '130.1'. The presence
of decimal places will raise error in the data wrangling
tab and hault the app."
of decimal places will raise an error in the data wrangling
tab and hault the app. The variable name
must be written in lowercase ('muac')."
),
tags$li(
tags$b("Oedema:"),
"values must be given in 'y' for yes,
and 'n' for no."
and 'n' for no. Variable names may follow any format.
For longer names, separate words with an underscore."
)
)
)
Expand Down Expand Up @@ -281,7 +310,7 @@ ui <- tagList(
style = "text-align: justify;",
tags$p(tags$b("Plausibility Check")),
tags$p(
"As above-described, this tab depends on the previous tab.
"As above described, this tab depends on the previous tab.
Select the same method as in the data wrangling. Thereafter,
supply the input fields with the corresponding variables
from the dataset. For this, a dropdown list of the variable
Expand Down
Loading