From f306cce1f7e2ad4a0fe3ca04f3c378d26e28ca88 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 00:53:49 +0200 Subject: [PATCH 01/30] import Roboto google font from Google fonts --- inst/app/www/custom.css | 76 +++++++++++++++++++++++++---------------- 1 file changed, 46 insertions(+), 30 deletions(-) diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index 75f7a22..c1e9016 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -1,22 +1,28 @@ +/* Import Roboto Font from Google Fonts */ + +@import url("https://fonts.googleapis.com/css2?family=Roboto:ital,wght@0,100..900;1,100..900&display=swap"); + + /* Global background */ body { - color: rgb(68, 68, 68); + color: rgb(68, 68, 68); background-color: #f9fdfb; - font-family: system-ui, "Segoe UI", Roboto, "Helvetica Neue", - "Noto Sans", "Liberation Sans", Arial, sans-serif, "Apple Color Emoji", - "Segoe UI Emoji", "Segoe UI Symbol", "Noto Color Emoji"; + font-family: system-ui, "Segoe UI", Roboto, "Helvetica Neue", + "Noto Sans", "Liberation Sans", Arial, sans-serif, "Apple Color Emoji", + "Segoe UI Emoji", "Segoe UI Symbol", "Noto Color Emoji"; } /* Navbar brand text */ .navbar-brand span { - box-sizing: border-box; + box-sizing: border-box; color: rgba(255, 255, 255, 0.7); color-scheme: dark; cursor: auto; display: inline; font-size: 21.25px; - font-weight: 400; height: auto; + font-weight: 400; + height: auto; line-height: 31.875px; text-align: start; text-underline-offset: 3px; @@ -25,6 +31,9 @@ body { width: auto; } +/* Menu items */ +.menu-items {} + /* Data upload progress bar */ span.btn.btn-default.btn-file { fill: #004225 !important; @@ -39,8 +48,9 @@ span.btn.btn-default.btn-file { /* Navbar container */ .navbar { - background-color: #004225 !important; - --bs-navbar-active-color: rgb(209, 197, 226, 0.8); /* active tab */ + background-color: #004225 !important; + --bs-navbar-active-color: rgb(209, 197, 226, 0.8); + /* active tab */ /* --bs-nav-link-color: rgba(255, 255, 255, 0.7); */ color: rgba(255, 255, 255, 0.7); border-bottom: 2px solid #13b955; @@ -48,11 +58,12 @@ span.btn.btn-default.btn-file { box-sizing: border-box; color-scheme: light; column-gap: 0px; - flex-direction: column; + flex-direction: column; display: flex; flex-wrap: nowrap; font-size: 17px; - font-weight: 400; height: 83.78125px; + font-weight: 400; + height: 83.78125px; justify-content: flex-start; line-height: 25.5px; padding-bottom: 20.4px; @@ -71,8 +82,10 @@ span.btn.btn-default.btn-file { } /* Panel headers or section titles */ -h1, h2, h3 { - color:rgb(68, 68, 68); +h1, +h2, +h3 { + color: rgb(68, 68, 68); } /* Set table of content's font-size to 15px */ @@ -80,17 +93,20 @@ h6 { font-size: 15px; } -/* Radio button labels */ -#wrangle_data-wrangle, #ipc_check-ipccheck, #plausible-method, -#prevalence-amn_method_survey, #prevalence-amn_method_screening, +/* Radio button labels */ +#wrangle_data-wrangle, +#ipc_check-ipccheck, +#plausible-method, +#prevalence-amn_method_survey, +#prevalence-amn_method_screening, #prevalence-source label { font-size: 14px; } /* Buttons */ .btn-primary { - background-color: #004225 !important; - border-color: #004225 !important; + background-color: #004225 !important; + border-color: #004225 !important; } .btn-primary:hover { @@ -99,21 +115,21 @@ h6 { } /* Radio buttons */ -.form-check-input:checked, -.shiny-input-container .checkbox input:checked, -.shiny-input-container .checkbox-inline input:checked, -.shiny-input-container .radio input:checked, +.form-check-input:checked, +.shiny-input-container .checkbox input:checked, +.shiny-input-container .checkbox-inline input:checked, +.shiny-input-container .radio input:checked, .shiny-input-container .radio-inline input:checked { - background-color:#004225; - border-color:#004225 + background-color: #004225; + border-color: #004225 } /* Pagination */ -.page-link.active, -.active > .page-link { - z-index: 3; - color: var(--bs-pagination-active-color); - background-color:#004225; - border-color:#004225; -} +.page-link.active, +.active>.page-link { + z-index: 3; + color: var(--bs-pagination-active-color); + background-color: #004225; + border-color: #004225; +} \ No newline at end of file From d5cfbccb1b94636d7a962599c3839fb64678e8cc Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 01:13:15 +0200 Subject: [PATCH 02/30] add favicon --- inst/app/ui.R | 387 ++++++++++++++++++++++++++++---------------------- 1 file changed, 215 insertions(+), 172 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 23e0352..6454dac 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -18,7 +18,9 @@ library(rlang) ui <- tagList( ### Link up with custom .css file ---- tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "custom.css") # external stylesheet + #tags$meta(name = "description", content = "mwana App"), + tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"), # external stylesheet + tags$link(rel = "icon", href = "logo.png") ), page_navbar( title = tags$div( @@ -27,7 +29,8 @@ ui <- tagList( ### Left side: app name and logo ---- tags$div( style = "display: flex; align-items: center;", - tags$span("mwana", + tags$span( + "mwana", style = "margin-right: 10px; font-family: Arial, sans-serif; font-size: 50px;" ), tags$a( @@ -40,10 +43,13 @@ ui <- tagList( ), ### Right side: app version ---- - tags$span(paste0( - "App v", utils::packageVersion("mwanaApp"), - " | Eng: mwana v", utils::packageVersion("mwana") - ), + tags$span( + paste0( + "App v", + utils::packageVersion("mwanaApp"), + " | Eng: mwana v", + utils::packageVersion("mwana") + ), id = "app-version", style = "font-size: 12.5px; color: rgba(255, 255, 255, 0.4); position: fixed; top: 40px; right: 20px;" @@ -84,12 +90,12 @@ ui <- tagList( ##### Left side: title + subtitle stacked ---- tags$div( style = "display: flex; flex-direction: column;", - tags$h3( - style = "marging: 0; font-weight: bold;", - "A seamless graphical interface to the mwana R package for data + tags$h3( + style = "marging: 0; font-weight: bold;", + "A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation of wasting" - ) - ), + ) + ), ##### Right side: logo ---- tags$a( @@ -102,123 +108,132 @@ ui <- tagList( ) ) ) - ), + ), - #### Welcome message ---- - tags$div( - id = "sec1", - style = "text-align: justify;", - tags$hr(), - tags$p( - " + #### Welcome message ---- + tags$div( + id = "sec1", + style = "text-align: justify;", + tags$hr(), + tags$p( + " This app is a lightweight, field-ready application thoughtful designed to seamlessly streamline plausibility checks and wasting prevalence estimation of child anthropometric data, by automating key steps of the R package ", - tags$a( - href = "https://mphimo.github.io/mwana/", - tags$code("mwana") - ), "for non-R users." + tags$a( + href = "https://mphimo.github.io/mwana/", + tags$code("mwana") ), - tags$p( - "The app is divided in five easy-to-navigate tabs, apart from + "for non-R users." + ), + tags$p( + "The app is divided in five easy-to-navigate tabs, apart from the Home - where you at right now.", - tags$ol( - tags$li(tags$b("Data Upload")), - tags$li(tags$b("Data Wrangling")), - tags$li(tags$b("Plausibility Check")), - tags$li(tags$b("Prevalence Analysis")), - tags$li(tags$b("IPC Check")) - ) - ), - tags$hr(), + tags$ol( + tags$li(tags$b("Data Upload")), + tags$li(tags$b("Data Wrangling")), + tags$li(tags$b("Plausibility Check")), + tags$li(tags$b("Prevalence Analysis")), + tags$li(tags$b("IPC Check")) + ) + ), + tags$hr(), - ##### Briefly describe each tab ---- - tags$div( - id = "sec2", - style = "text-align: justify;", + ##### Briefly describe each tab ---- + tags$div( + id = "sec2", + style = "text-align: justify;", - ###### Data Upload tab ---- - tags$p(tags$b("Data Upload")), - tags$p( - " + ###### Data Upload tab ---- + tags$p(tags$b("Data Upload")), + tags$p( + " This is where the workflow begins. Upload the 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. " - ), - tags$ul( - tags$li( - tags$b("Data requirements"), - tags$p( - " + ), + tags$ul( + tags$li( + tags$b("Data requirements"), + tags$p( + " The data to be uploaded must have been tidy up in accordance - to the below-described app's", tags$b("input file"), "and", - tags$b("input variable"), "requirements: + to the below-described app's", + tags$b("input file"), + "and", + tags$b("input variable"), + "requirements: " - ), - tags$ul( - tags$li( - tags$b("Input file requirements"), - tags$ul( - tags$li( - tags$b("File naming:"), "the file name must use + ), + tags$ul( + tags$li( + tags$b("Input file requirements"), + tags$ul( + tags$li( + tags$b("File naming:"), + "the file name must use underscore ( _ ) to separate words. Hyphen ( - ) or simple spaces will lead to errors along the uploading process. Consider the following naming example:", - tags$em("my_file_to_upload.csv") - ) + tags$em("my_file_to_upload.csv") ) - ), - tags$br(), - tags$li( - tags$b("Input variable requirements"), - tags$ul( - tags$li( - tags$b("Age:"), "values must be in months. The variable name + ) + ), + tags$br(), + tags$li( + tags$b("Input variable requirements"), + tags$ul( + tags$li( + tags$b("Age:"), + "values must be in months. The variable name must be written in lowercase ('age')." - ), - tags$li( - tags$b("Sex:"), "values must be given in 'm' for boys and 'f' + ), + tags$li( + tags$b("Sex:"), + "values must be given in 'm' for boys and 'f' for girls." - ), - tags$li( - tags$b("MUAC:"), "values must be in millimetres. Ensure there + ), + 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." - ), - tags$li( - tags$b("Oedema:"), "values must be given in 'y' for yes, + ), + tags$li( + tags$b("Oedema:"), + "values must be given in 'y' for yes, and 'n' for no." - ) ) ) ) ) ) - ), - tags$hr(), + ) + ), + tags$hr(), - ###### Data Wrangling tab ---- - tags$div( - id = "sec3", - style = "text-align: justify;", - tags$p(tags$b("Data Wrangling")), - tags$p( - " + ###### Data Wrangling tab ---- + tags$div( + id = "sec3", + style = "text-align: justify;", + tags$p(tags$b("Data Wrangling")), + tags$p( + " Wrangle the dataset for downstream workflow. For this, different wrangling methods are given. Upon completion, this tab's output becomes available in subsequent tabs; therefore, the wrangling method selected herein should match the intended analysis. " - ), - tags$p( - " + ), + tags$p( + " Under the hood, the wrangling process consists in calculating age in months and excluding all records that fall under six months and over 59.99 months. Then, it computes z-scores - if @@ -226,19 +241,27 @@ ui <- tagList( based on the SMART flagging criteria - for z-scores. For MUAC, when age in months is not available, values under 100 and over 200 millimetres are considered as outliers. At the the end, two new - columns get added into the dataset:", tags$code("wfhz"), "and", - tags$code("flag_wfhz"), "for weight-for-heigh z-scores and flagged + columns get added into the dataset:", + tags$code("wfhz"), + "and", + tags$code("flag_wfhz"), + "for weight-for-heigh z-scores and flagged records, respectively. Moreover, when working with MUAC and when - age is available, the following columns get added:", tags$code("mfaz"), - "and", tags$code("flag_mfaz"), "for MUAC-for-age z-scores and flagged + age is available, the following columns get added:", + tags$code("mfaz"), + "and", + tags$code("flag_mfaz"), + "for MUAC-for-age z-scores and flagged records, respectively. Finally, when age is not available, only one - column gets added:", tags$code("flag_muac"), "which indicates + column gets added:", + tags$code("flag_muac"), + "which indicates the flagged records based on the above-mentioned criterion. " - ), - tags$p( - " + ), + tags$p( + " Once the wrangling process is completed, a preview of the output is displayed on the right side of the tab, wherein the first 20 rows are shown. You can get a full view of the entire dataset by @@ -246,17 +269,17 @@ ui <- tagList( thereafter look for the file in the 'downloads' folder on your computer. " - ) - ), - tags$hr(), + ) + ), + tags$hr(), - ###### Plausibility Check tab ---- - tags$div( - id = "sec4", - style = "text-align: justify;", - tags$p(tags$b("Plausibility Check")), - tags$p( - "As above-described, this tab depends on the previous tab. + ###### Plausibility Check tab ---- + tags$div( + id = "sec4", + style = "text-align: justify;", + tags$p(tags$b("Plausibility Check")), + tags$p( + "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 @@ -265,36 +288,43 @@ ui <- tagList( The app lets you get the plausibility checks results grouped by different categories - up to a maximum of three. For this, - supply the grouping variables to", tags$code("Area 1"), - tags$code("Area 2"), "and", tags$code("Area 3") - ), - tags$p(tags$em( - "For example: In your dataset, there are the following + supply the grouping variables to", + tags$code("Area 1"), + tags$code("Area 2"), + "and", + tags$code("Area 3") + ), + tags$p(tags$em( + "For example: In your dataset, there are the following indentifying variables: 'state', 'county', and 'team'. You wish to get the plausibility check results grouped by province, then by county and then you also wish to check the results by survey teams that worked in each county and provinces. You can achieve this simply by supplying 'province' to", - tags$code("Area 1"), "'county' to", tags$code("Area 2"), - "and 'team' to", tags$code("Area 3"), "." - )), - tags$p( - " + tags$code("Area 1"), + "'county' to", + tags$code("Area 2"), + "and 'team' to", + tags$code("Area 3"), + "." + )), + tags$p( + " Upon completion, you can download the results into Excel by clicking on the 'Download Results' button found at the bottom-right side of the tab. " - ) - ), - tags$hr(), + ) + ), + tags$hr(), - ###### Prevalence Analysis tab ---- - tags$div( - id = "sec5", - style = "text-align: justify;", - tags$p(tags$b("Prevalence Analysis")), - tags$p( - " + ###### Prevalence Analysis tab ---- + tags$div( + id = "sec5", + style = "text-align: justify;", + tags$p(tags$b("Prevalence Analysis")), + tags$p( + " As afore-mentioned, this tab depends on the data wrangling. The app lets you estimate prevalence derived from survey and screening. Therefore, the first step is to select the @@ -304,77 +334,90 @@ ui <- tagList( or resort to a fallback - when 'No' is selected. In the latter case, you must have a variable called", - tags$code("age_cat"), ".", "This should have the following + tags$code("age_cat"), + ".", + "This should have the following categories: '6-23' for each record wherein age is between 6 and 23 months, and '24-59' for when age is between 24 and 59 monts. - This must be done before uploading the data.", "The", - tags$code("age_cat"), "variable is supplied to the ", - tags$code("Age categories (6-23 and 24-59)"), "input field. + This must be done before uploading the data.", + "The", + tags$code("age_cat"), + "variable is supplied to the ", + tags$code("Age categories (6-23 and 24-59)"), + "input field. This ensures that MUAC-based prevalence gets age-weighted - whenever there is excess of children in the 6-23' category.", "Read more", - tags$a("here", href = "https://mphimo.github.io/mwana/dev/reference/age_ratio.html"), - "and", tags$a("here", href = "https://mphimo.github.io/mwana/dev/articles/prevalence.html#sec-prevalence-muac"), - "." + whenever there is excess of children in the 6-23' category.", + "Read more", + tags$a( + "here", + href = "https://mphimo.github.io/mwana/dev/reference/age_ratio.html" ), - tags$p( - " + "and", + tags$a( + "here", + href = "https://mphimo.github.io/mwana/dev/articles/prevalence.html#sec-prevalence-muac" + ), + "." + ), + tags$p( + " Thereafter, the next step is to select the method to define acute malnutrition. Then, supply the input variables as required. " - ), - tags$p( - " + ), + tags$p( + " You can also group the analysis by different groups, as explained in the plausibility check section. Follow the same guide provided therein. " - ) - ), - tags$hr(), + ) + ), + tags$hr(), - ###### IPC Check tab ---- - tags$div( - id = "sec6", - style = "text-align: justify;", - tags$p(tags$b("IPC Check")), - tags$p( - " + ###### IPC Check tab ---- + tags$div( + id = "sec6", + style = "text-align: justify;", + tags$p(tags$b("IPC Check")), + tags$p( + " This lets you check whether the IPC Acute Malnutrition evidence requirements for outcome data have been met or not. It checks against survey, screening and sentinel sites data source-related requirements, in accordance with the IPC protocols. " - ), - tags$p( - " + ), + tags$p( + " This tab depends on the 'Upload Data' tab; this means that you can check the requirements even before the wrangling the data. " - ) - ), - tags$hr(), - tags$div( - id = "sec7", - style = "text-align: justify;", - tags$p(tags$b("Authorship")), - tags$p( - "This app was developed and is maintained by Tomás Zaba." - ) - ), - tags$hr(), - tags$div( - id = "sec8", - style = "text-align: justify;", - tags$p(tags$b("License")), - tags$p( - "This app is licensed under the GPL (>=3) license." - ) + ) + ), + tags$hr(), + tags$div( + id = "sec7", + style = "text-align: justify;", + tags$p(tags$b("Authorship")), + tags$p( + "This app was developed and is maintained by Tomás Zaba." + ) + ), + tags$hr(), + tags$div( + id = "sec8", + style = "text-align: justify;", + tags$p(tags$b("License")), + tags$p( + "This app is licensed under the GPL (>=3) license." ) ) ) ) ) + ) ), ## ---- Tab 2: Data Upload --------------------------------------------------- @@ -412,4 +455,4 @@ ui <- tagList( mwanaApp:::module_ui_ipccheck(id = "ipc_check") ) ) -) \ No newline at end of file +) From 1b614aa188b340172a4ca2e9fc2977f637ae9fb6 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 01:23:38 +0200 Subject: [PATCH 03/30] set Roboto as the font-family --- inst/app/ui.R | 2 +- inst/app/www/custom.css | 7 +------ 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 6454dac..37642f6 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -31,7 +31,7 @@ ui <- tagList( style = "display: flex; align-items: center;", tags$span( "mwana", - style = "margin-right: 10px; font-family: Arial, sans-serif; font-size: 50px;" + style = "margin-right: 10px; font-family: Roboto, Arial, sans-serif; font-size: 50px;" ), tags$a( href = "https://mphimo.github.io/mwana/", diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index c1e9016..27b36c7 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -7,9 +7,7 @@ body { color: rgb(68, 68, 68); background-color: #f9fdfb; - font-family: system-ui, "Segoe UI", Roboto, "Helvetica Neue", - "Noto Sans", "Liberation Sans", Arial, sans-serif, "Apple Color Emoji", - "Segoe UI Emoji", "Segoe UI Symbol", "Noto Color Emoji"; + font-family: Roboto, Arial, sans-serif, "Helvetica Neue", } @@ -31,9 +29,6 @@ body { width: auto; } -/* Menu items */ -.menu-items {} - /* Data upload progress bar */ span.btn.btn-default.btn-file { fill: #004225 !important; From f0a30c83bf60775d23b544bfb269776f41bc821d Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 19:00:46 +0200 Subject: [PATCH 04/30] revise css ruleset: navbar --- inst/app/ui.R | 9 ++- inst/app/www/custom.css | 138 ++++++++++++---------------------------- 2 files changed, 45 insertions(+), 102 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 37642f6..3c4baf8 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -24,20 +24,19 @@ ui <- tagList( ), page_navbar( title = tags$div( - style = "display: flex; align-items: center; justify-content: space-between; width: 100%;", + class = "page-navbar", ### Left side: app name and logo ---- tags$div( - style = "display: flex; align-items: center;", + class = "brand", tags$span( + class = "brand-span", "mwana", - style = "margin-right: 10px; font-family: Roboto, Arial, sans-serif; font-size: 50px;" ), tags$a( href = "https://mphimo.github.io/mwana/", tags$span( - tags$img(src = "logo.png", height = "40px"), - style = "margin-right: 20px;" + tags$img(src = "logo.png"), ) ) ), diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index 27b36c7..e78680d 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -4,127 +4,71 @@ /* Global background */ + body { - color: rgb(68, 68, 68); background-color: #f9fdfb; + color: rgb(68, 68, 68); font-family: Roboto, Arial, sans-serif, "Helvetica Neue", } +/* Navigation bar */ -/* Navbar brand text */ -.navbar-brand span { - box-sizing: border-box; - color: rgba(255, 255, 255, 0.7); - color-scheme: dark; - cursor: auto; - display: inline; - font-size: 21.25px; - font-weight: 400; - height: auto; - line-height: 31.875px; - text-align: start; - text-underline-offset: 3px; - text-wrap-mode: nowrap; - white-space-collapse: collapse; - width: auto; -} - -/* Data upload progress bar */ -span.btn.btn-default.btn-file { - fill: #004225 !important; +nav .container-fluid { background-color: #004225; + margin-left: -10px; + margin-top: -1rem; + height: 90px; + width: 100%; + display: flex; + margin-bottom: -0.5rem; } -/* Data upload progress bar */ -.progress-bar { - fill: #004225 !important; - background-color: #004225 !important; -} +/* Target navigation bar */ -/* Navbar container */ -.navbar { - background-color: #004225 !important; - --bs-navbar-active-color: rgb(209, 197, 226, 0.8); - /* active tab */ - /* --bs-nav-link-color: rgba(255, 255, 255, 0.7); */ - color: rgba(255, 255, 255, 0.7); - border-bottom: 2px solid #13b955; +.page-navbar { align-items: center; - box-sizing: border-box; - color-scheme: light; - column-gap: 0px; - flex-direction: column; display: flex; - flex-wrap: nowrap; - font-size: 17px; - font-weight: 400; - height: 83.78125px; - justify-content: flex-start; - line-height: 25.5px; - padding-bottom: 20.4px; - padding-left: 17px; - padding-right: 17px; - padding-top: 20.4px; - position: relative; - text-align: start; - width: 1920px; + justify-content: space-between; + width: 100%; + height: 50px; + color: rgba(255, 255, 255, 0.7); } -/* Highlight colour on hover */ -.navbar-nav { - --bs-nav-link-color: rgba(255, 255, 255, 0.7); - --bs-nav-link-hover-color: rgba(209, 197, 226, 0.8); -} +/* Target brand name and logo*/ -/* Panel headers or section titles */ -h1, -h2, -h3 { - color: rgb(68, 68, 68); +.brand, +.brand-span { + margin-right: 10px; + margin-top: 12px; + font-family: Roboto, Arial, Helvetica, sans-serif; + font-size: 50px; + display: flex; + align-items: center; + color: rgba(255, 255, 255, 0.7); } -/* Set table of content's font-size to 15px */ -h6 { - font-size: 15px; -} -/* Radio button labels */ -#wrangle_data-wrangle, -#ipc_check-ipccheck, -#plausible-method, -#prevalence-amn_method_survey, -#prevalence-amn_method_screening, -#prevalence-source label { - font-size: 14px; +a span { + margin-right: 20px; } -/* Buttons */ -.btn-primary { - background-color: #004225 !important; - border-color: #004225 !important; +a span img { + height: 40px; + margin-right: 20px; + margin-left: 0px; + margin-top: 12px; } -.btn-primary:hover { - background-color: rgba(255, 255, 255, 0.7); - color: rgba(209, 197, 226, 0.8); -} +/* Target tab list elements */ -/* Radio buttons */ -.form-check-input:checked, -.shiny-input-container .checkbox input:checked, -.shiny-input-container .checkbox-inline input:checked, -.shiny-input-container .radio input:checked, -.shiny-input-container .radio-inline input:checked { - background-color: #004225; - border-color: #004225 +.nav-link { + color: rgba(255, 255, 255, 0.7); + font-family: Roboto; + font-size: 15px; } -/* Pagination */ +/* Target tab lists on hover */ -.page-link.active, -.active>.page-link { - z-index: 3; - color: var(--bs-pagination-active-color); - background-color: #004225; - border-color: #004225; +.nav-link:hover { + color: rgba(209, 197, 226, 0.8); } \ No newline at end of file From 2f25e0cf5bf005523b202c93faad8aebda6eba78 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 19:07:23 +0200 Subject: [PATCH 05/30] set ancor elements to open in separate tab --- inst/app/ui.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 3c4baf8..d581b7f 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -35,6 +35,7 @@ ui <- tagList( ), tags$a( href = "https://mphimo.github.io/mwana/", + target = "_blank", tags$span( tags$img(src = "logo.png"), ) @@ -99,6 +100,7 @@ ui <- tagList( ##### Right side: logo ---- tags$a( href = "https://mphimo.github.io/mwana/", + target = "_blank", tags$img( src = "logo.png", height = "160px", @@ -123,6 +125,7 @@ ui <- tagList( ", tags$a( href = "https://mphimo.github.io/mwana/", + target = "_blank", tags$code("mwana") ), "for non-R users." @@ -349,12 +352,14 @@ ui <- tagList( "Read more", tags$a( "here", - href = "https://mphimo.github.io/mwana/dev/reference/age_ratio.html" + href = "https://mphimo.github.io/mwana/dev/reference/age_ratio.html", + target = "_blank", ), "and", tags$a( "here", - href = "https://mphimo.github.io/mwana/dev/articles/prevalence.html#sec-prevalence-muac" + href = "https://mphimo.github.io/mwana/dev/articles/prevalence.html#sec-prevalence-muac", + target = "_blank", ), "." ), From 1e29d35be66a959963ad505d92eacfe108a66578 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 19:09:26 +0200 Subject: [PATCH 06/30] close #46 --- inst/app/ui.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index d581b7f..8cbbcb2 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -352,13 +352,13 @@ ui <- tagList( "Read more", tags$a( "here", - href = "https://mphimo.github.io/mwana/dev/reference/age_ratio.html", + href = "https://mphimo.github.io/mwana/reference/age_ratio.html", target = "_blank", ), "and", tags$a( "here", - href = "https://mphimo.github.io/mwana/dev/articles/prevalence.html#sec-prevalence-muac", + href = "https://mphimo.github.io/mwana/articles/prevalence.html#sec-prevalence-muac", target = "_blank", ), "." From 7464a05b463b24567b8b36612ca0c9038952261c Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 19:15:05 +0200 Subject: [PATCH 07/30] add metadata to header element --- inst/app/ui.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 8cbbcb2..e230cb8 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -18,9 +18,10 @@ library(rlang) ui <- tagList( ### Link up with custom .css file ---- tags$head( - #tags$meta(name = "description", content = "mwana App"), + tags$meta(charset = "UTF-8"), + tags$meta(name = "description", content = "mwana App"), tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"), # external stylesheet - tags$link(rel = "icon", href = "logo.png") + tags$link(rel = "icon", href = "logo.png"), ), page_navbar( title = tags$div( From 9bd3df412c9a2f696902e4b25939985797a73a91 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 19:53:40 +0200 Subject: [PATCH 08/30] display app name on the web browser --- inst/app/ui.R | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/app/ui.R b/inst/app/ui.R index e230cb8..795f619 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -20,6 +20,7 @@ ui <- tagList( tags$head( tags$meta(charset = "UTF-8"), tags$meta(name = "description", content = "mwana App"), + tags$title("mwana App"), tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"), # external stylesheet tags$link(rel = "icon", href = "logo.png"), ), From 57f3013f6f3cf77059e61d6db129d7914c1ea387 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 20:02:59 +0200 Subject: [PATCH 09/30] style tab when active --- inst/app/www/custom.css | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index e78680d..3ce34a9 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -47,7 +47,6 @@ nav .container-fluid { color: rgba(255, 255, 255, 0.7); } - a span { margin-right: 20px; } @@ -67,6 +66,12 @@ a span img { font-size: 15px; } +/* Emphasise active tab */ + +.navbar-nav .nav-link.active { + color: rgba(255, 255, 255, 0.7); +} + /* Target tab lists on hover */ .nav-link:hover { From 436c5d1ca0cec7c8dbb8f3afa14ab1c3f06def6c Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 20:30:40 +0200 Subject: [PATCH 10/30] place app version 60px from the top --- inst/app/ui.R | 6 ++---- inst/app/www/custom.css | 37 ++++++++++++++++++++++++++++--------- 2 files changed, 30 insertions(+), 13 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 795f619..11c270a 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -46,15 +46,13 @@ ui <- tagList( ### Right side: app version ---- tags$span( + class = "app-version", paste0( "App v", utils::packageVersion("mwanaApp"), " | Eng: mwana v", utils::packageVersion("mwana") - ), - id = "app-version", - style = "font-size: 12.5px; color: rgba(255, 255, 255, 0.4); - position: fixed; top: 40px; right: 20px;" + ) ) ), diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index 3ce34a9..af8ac83 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -3,7 +3,8 @@ @import url("https://fonts.googleapis.com/css2?family=Roboto:ital,wght@0,100..900;1,100..900&display=swap"); -/* Global background */ +/* ---- Global background --------------------------------------------------- */ + body { background-color: #f9fdfb; @@ -11,30 +12,35 @@ body { font-family: Roboto, Arial, sans-serif, "Helvetica Neue", } -/* Navigation bar */ +/* ---- Navigation bar ------------------------------------------------------ */ + + +/* Navbar container */ +nav, nav .container-fluid { background-color: #004225; - margin-left: -10px; margin-top: -1rem; height: 90px; - width: 100%; - display: flex; - margin-bottom: -0.5rem; + width: 100vw; + border: none; + margin: 0; + padding: 0; } -/* Target navigation bar */ +/* Brand (name and logo) */ .page-navbar { align-items: center; display: flex; justify-content: space-between; width: 100%; + padding-right: 30px; height: 50px; color: rgba(255, 255, 255, 0.7); } -/* Target brand name and logo*/ +/* Brand name */ .brand, .brand-span { @@ -47,6 +53,8 @@ nav .container-fluid { color: rgba(255, 255, 255, 0.7); } +/* Logo */ + a span { margin-right: 20px; } @@ -58,7 +66,7 @@ a span img { margin-top: 12px; } -/* Target tab list elements */ +/* Tab list elements */ .nav-link { color: rgba(255, 255, 255, 0.7); @@ -76,4 +84,15 @@ a span img { .nav-link:hover { color: rgba(209, 197, 226, 0.8); +} + +/* App version */ + +.app-version { + font-size: 12.5px; + color: rgba(255, 255, 255, 0.3); + position: fixed; + top: 60px; + right: 20px; + font-family: Roboto, Arial, Helvetica, sans-serif; } \ No newline at end of file From c0a14a164fb07c5aff3afa283cc73d92005e537f Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 20:43:42 +0200 Subject: [PATCH 11/30] set font-family to Roboto, Arial, Sans-serif, 'Helvetica Neue' --- inst/app/ui.R | 2 +- inst/app/www/custom.css | 17 +++++++++++++++-- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 11c270a..36e1689 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -65,7 +65,7 @@ ui <- tagList( ### Left sidebar for contents ---- layout_sidebar( sidebar = tags$div( - style = "padding: 1rem;", + class = "table-contents", tags$h4("Contents"), tags$h6(tags$a(href = "#sec1", "Welcome")), tags$h6(tags$a(href = "#sec2", "Data Upload")), diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index af8ac83..ce11b24 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -9,7 +9,17 @@ body { background-color: #f9fdfb; color: rgb(68, 68, 68); - font-family: Roboto, Arial, sans-serif, "Helvetica Neue", +} + +p, +li, +h6, +h4, +h3, +b, +h6, +span { + font-family: Roboto, Arial, sans-serif, "Helvetica Neue"; } @@ -95,4 +105,7 @@ a span img { top: 60px; right: 20px; font-family: Roboto, Arial, Helvetica, sans-serif; -} \ No newline at end of file +} + + +/* ---- Main page ----------------------------------------------------------- */ \ No newline at end of file From ae29e69668fc53a3d0f48c0844e4539977077ba5 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 20:54:32 +0200 Subject: [PATCH 12/30] style buttons, progress bars and table pagination --- inst/app/www/custom.css | 63 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 62 insertions(+), 1 deletion(-) diff --git a/inst/app/www/custom.css b/inst/app/www/custom.css index ce11b24..8d0574e 100644 --- a/inst/app/www/custom.css +++ b/inst/app/www/custom.css @@ -108,4 +108,65 @@ a span img { } -/* ---- Main page ----------------------------------------------------------- */ \ No newline at end of file +/* ---- Progress bar -------------------------------------------------------- */ + + +/* Data upload progress bar */ +span.btn.btn-default.btn-file { + fill: #004225 !important; + background-color: #004225; +} + +/* Data upload progress bar */ +.progress-bar { + fill: #004225 !important; + background-color: #004225 !important; +} + + +/* ---- Radio Buttons ------------------------------------------------------- */ + + +/* Radio button labels */ +#wrangle_data-wrangle, +#ipc_check-ipccheck, +#plausible-method, +#prevalence-amn_method_survey, +#prevalence-amn_method_screening, +#prevalence-source label { + font-size: 14px; +} + +/* Buttons */ +.btn-primary { + background-color: #004225 !important; + border-color: #004225 !important; +} + +.btn-primary:hover { + background-color: rgba(255, 255, 255, 0.7); + color: rgba(209, 197, 226, 0.8); +} + +/* Radio buttons */ +.form-check-input:checked, +.shiny-input-container .checkbox input:checked, +.shiny-input-container .checkbox-inline input:checked, +.shiny-input-container .radio input:checked, +.shiny-input-container .radio-inline input:checked { + background-color: #004225; + border-color: #004225 +} + + +/* ---- Pagination ---------------------------------------------------------- */ + +/* Pagination of table under view data */ + +.page-link.active, +.active>.page-link { + z-index: 3; + color: var(--bs-pagination-active-color); + background-color: #004225; + border-color: #004225; +} \ No newline at end of file From 06cd6b8ac8a6666245dcdc4b7c8e9f2e7e8cb991 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 28 May 2026 21:13:40 +0200 Subject: [PATCH 13/30] lint code --- R/module-helpers-prevalence.R | 354 ++++++++++++++++++++++------------ man/mwanaApp-package.Rd | 2 +- 2 files changed, 229 insertions(+), 127 deletions(-) diff --git a/R/module-helpers-prevalence.R b/R/module-helpers-prevalence.R index 631e21e..2f4564d 100644 --- a/R/module-helpers-prevalence.R +++ b/R/module-helpers-prevalence.R @@ -5,39 +5,49 @@ #' #' #' Display input variables dynamically, according to UI for screening -#' -#' -#' @param vars,source,indicator_surv,has_age Input variables collected +#' +#' +#' @param vars,source,indicator_surv,has_age Input variables collected #' from the UI and required to pass to `{mwana}` prevalence functions. -#' +#' #' @param ns A placeholder for Shiny module namespace. #' #' @keywords internal #' #' mod_prevalence_display_input_variables <- function( - vars, source, indicator_surv, has_age, ns) { + vars, + source, + indicator_surv, + has_age, + ns +) { ### Base list input vars ---- inputs <- list( shiny::selectInput( inputId = ns("area1"), label = shiny::tagList( - htmltools::tags$span("Area 1", + htmltools::tags$span( + "Area 1", style = "font-size: 14px; font-weight: bold;" ), htmltools::tags$div( - style = "font-size: 0.85em; color: #6c7574;", "(Primary area)" + style = "font-size: 0.85em; color: #6c7574;", + "(Primary area)" ) ), choices = c("", vars) ), - shiny::selectInput(ns("area2"), + shiny::selectInput( + ns("area2"), label = shiny::tagList( - htmltools::tags$span("Area 2", + htmltools::tags$span( + "Area 2", style = "font-size: 14px; font-weight: bold;" ), htmltools::tags$div( - style = "font-size: 0.85em; color: #6c7574;", "(Sub-area)" + style = "font-size: 0.85em; color: #6c7574;", + "(Sub-area)" ) ), choices = c("", vars) @@ -45,111 +55,129 @@ mod_prevalence_display_input_variables <- function( shiny::selectInput( inputId = ns("area3"), label = shiny::tagList( - htmltools::tags$span("Area 3", + htmltools::tags$span( + "Area 3", style = "font-size: 14px; font-weight: bold;" ), htmltools::tags$div( - style = "font-size: 0.85em; color: #6c7574;", "Sub-area)" + style = "font-size: 0.85em; color: #6c7574;", + "Sub-area)" ) ), choices = c("", vars) - ), + ), shiny::selectInput( inputId = ns("wts"), label = shiny::tagList( - htmltools::tags$span("Survey weights", + htmltools::tags$span( + "Survey weights", style = "font-size: 14px; font-weight: bold;" ), htmltools::tags$div( style = "font-size: 0.85em; color: #6c7574;", "Final survey weights for weighted analysis" - ) - ), - choices = c("", vars) - ) + ) + ), + choices = c("", vars) + ) ) #### Conditional inputs depending on source of data ---- if (source == "survey") { - inputs <- c(inputs, list( - if (isTRUE(indicator_surv == "muac")) { - #### Display age ---- - shiny::tagList( + inputs <- c( + inputs, + list( + if (isTRUE(indicator_surv == "muac")) { + #### Display age ---- + shiny::tagList( + shiny::selectInput( + inputId = ns("muac"), + label = shiny::tagList( + htmltools::tags$span( + "MUAC", + style = "font-size: 14px; font-weight: bold;" + ), + htmltools::tags$span("*", style = "color: red;") + ), + choices = c("", vars) + ), + shiny::selectInput( + inputId = ns("age"), + label = shiny::tagList( + htmltools::tags$span( + "Age (months)", + style = "font-size: 14px; font-weight: bold;" + ), + htmltools::tags$span("*", style = "color: red;") + ), + choices = c("", vars) + ) + ) + } + ) + ) + } + + if (source == "screening") { + inputs <- c( + inputs, + list( + shiny::selectInput( + inputId = ns("muac"), + label = shiny::tagList( + htmltools::tags$span( + "MUAC", + style = "font-size: 14px; font-weight: bold;" + ), + htmltools::tags$span("*", style = "color: red;") + ), + choices = c("", vars) + ), + if (isTRUE(has_age == "yes")) { shiny::selectInput( - inputId = ns("muac"), + inputId = ns("age"), label = shiny::tagList( - htmltools::tags$span("MUAC", + htmltools::tags$span( + "Age (months)", style = "font-size: 14px; font-weight: bold;" ), htmltools::tags$span("*", style = "color: red;") ), choices = c("", vars) - ), + ) + } else { shiny::selectInput( - inputId = ns("age"), + inputId = ns("age_cat"), label = shiny::tagList( - htmltools::tags$span("Age (months)", + htmltools::tags$span( + "Age categories (6-23 and 24-59)", style = "font-size: 14px; font-weight: bold;" ), htmltools::tags$span("*", style = "color: red;") ), choices = c("", vars) ) - ) - } - )) + } + ) + ) } - if (source == "screening") { - inputs <- c(inputs, list( + # Always add oedema at the end + inputs_vars <- c( + inputs, + list( shiny::selectInput( - inputId = ns("muac"), + inputId = ns("oedema"), label = shiny::tagList( - htmltools::tags$span("MUAC", + htmltools::tags$span( + "Oedema", style = "font-size: 14px; font-weight: bold;" - ), - htmltools::tags$span("*", style = "color: red;") + ) ), choices = c("", vars) - ), - if (isTRUE(has_age == "yes")) { - shiny::selectInput( - inputId = ns("age"), - label = shiny::tagList( - htmltools::tags$span("Age (months)", - style = "font-size: 14px; font-weight: bold;" - ), - htmltools::tags$span("*", style = "color: red;") - ), - choices = c("", vars) - ) - } else { - shiny::selectInput( - inputId = ns("age_cat"), - label = shiny::tagList( - htmltools::tags$span("Age categories (6-23 and 24-59)", - style = "font-size: 14px; font-weight: bold;" - ), - htmltools::tags$span("*", style = "color: red;") - ), - choices = c("", vars) - ) - } - )) - } - - # Always add oedema at the end - inputs_vars <- c(inputs, list( - shiny::selectInput( - inputId = ns("oedema"), - label = shiny::tagList( - htmltools::tags$span("Oedema", - style = "font-size: 14px; font-weight: bold;" - ) - ), - choices = c("", vars) + ) ) - )) + ) inputs_vars } @@ -160,27 +188,42 @@ mod_prevalence_display_input_variables <- function( #' #' Invoke mwana's prevalence functions from within module server according to #' user specifications in the UI -#' -#' @param df,wts,oedema,area1,area2,area3 Input variables collected from the UI +#' +#' @param df,wts,oedema,area1,area2,area3 Input variables collected from the UI #' and required to pass to mwana::mw_estimate_prevalence_wfhz(). -#' +#' #' @returns A summary tibble for the descriptive statistics about wasting. #' #' @keywords internal #' #' mod_prevalence_call_wfhz_prev_estimator <- function( - df, wts = NULL, oedema = NULL, - area1, area2, area3) { + df, + wts = NULL, + oedema = NULL, + area1, + area2, + area3 +) { ## Build the grouping variables dynamically ---- dots <- list() - if (!is.null(area1) && nzchar(area1)) dots <- c(dots, list(rlang::sym(area1))) - if (!is.null(area2) && nzchar(area2)) dots <- c(dots, list(rlang::sym(area2))) - if (!is.null(area3) && nzchar(area3)) dots <- c(dots, list(rlang::sym(area3))) + if (!is.null(area1) && nzchar(area1)) { + dots <- c(dots, list(rlang::sym(area1))) + } + if (!is.null(area2) && nzchar(area2)) { + dots <- c(dots, list(rlang::sym(area2))) + } + if (!is.null(area3) && nzchar(area3)) { + dots <- c(dots, list(rlang::sym(area3))) + } ## Determine wt and oedema arguments - only convert to symbol if valid ---- wt_arg <- if (!is.null(wts) && nzchar(wts)) rlang::sym(wts) else NULL - oedema_arg <- if (!is.null(oedema) && nzchar(oedema)) rlang::sym(oedema) else NULL + oedema_arg <- if (!is.null(oedema) && nzchar(oedema)) { + rlang::sym(oedema) + } else { + NULL + } ## Call the function once with dynamic arguments ---- mwana::mw_estimate_prevalence_wfhz( @@ -198,23 +241,36 @@ mod_prevalence_call_wfhz_prev_estimator <- function( #' Invoke mwana's prevalence functions from within module server according to #' user specifications in the UI #' -#' @param df,age,muac,wts,oedema,area1,area2,area3 Input variables collected +#' @param df,age,muac,wts,oedema,area1,area2,area3 Input variables collected #' from the UI and required to pass to mwana::mw_estimate_prevalence_muac(). -#' -#' @returns A summary tibble for the descriptive statistics about wasting based +#' +#' @returns A summary tibble for the descriptive statistics about wasting based #' on MUAC, with confidence intervals. -#' +#' #' @keywords internal #' #' mod_prevalence_call_muac_prev_estimator <- function( - df, age, muac, wts = NULL, oedema = NULL, - area1, area2, area3) { + df, + age, + muac, + wts = NULL, + oedema = NULL, + area1, + area2, + area3 +) { # Build the grouping variables dynamically ---- dots <- list() - if (nzchar(area1)) dots <- c(dots, list(rlang::sym(area1))) - if (nzchar(area2)) dots <- c(dots, list(rlang::sym(area2))) - if (nzchar(area3)) dots <- c(dots, list(rlang::sym(area3))) + if (nzchar(area1)) { + dots <- c(dots, list(rlang::sym(area1))) + } + if (nzchar(area2)) { + dots <- c(dots, list(rlang::sym(area2))) + } + if (nzchar(area3)) { + dots <- c(dots, list(rlang::sym(area3))) + } # Determine wt and oedema arguments ---- wt_arg <- if (nzchar(wts)) rlang::sym(wts) else NULL @@ -242,17 +298,32 @@ mod_prevalence_call_muac_prev_estimator <- function( #' #' mod_prevalence_call_combined_prev_estimator <- function( - df, wts = NULL, oedema = NULL, - area1, area2, area3) { + df, + wts = NULL, + oedema = NULL, + area1, + area2, + area3 +) { ## Build the grouping variables dynamically ---- dots <- list() - if (!is.null(area1) && nzchar(area1)) dots <- c(dots, list(rlang::sym(area1))) - if (!is.null(area2) && nzchar(area2)) dots <- c(dots, list(rlang::sym(area2))) - if (!is.null(area3) && nzchar(area3)) dots <- c(dots, list(rlang::sym(area3))) + if (!is.null(area1) && nzchar(area1)) { + dots <- c(dots, list(rlang::sym(area1))) + } + if (!is.null(area2) && nzchar(area2)) { + dots <- c(dots, list(rlang::sym(area2))) + } + if (!is.null(area3) && nzchar(area3)) { + dots <- c(dots, list(rlang::sym(area3))) + } ## Determine wt and oedema arguments - only convert to symbol if valid ---- wt_arg <- if (!is.null(wts) && nzchar(wts)) rlang::sym(wts) else NULL - oedema_arg <- if (!is.null(oedema) && nzchar(oedema)) rlang::sym(oedema) else NULL + oedema_arg <- if (!is.null(oedema) && nzchar(oedema)) { + rlang::sym(oedema) + } else { + NULL + } ## Call the function once with dynamic arguments ---- mwana::mw_estimate_prevalence_combined( @@ -269,23 +340,37 @@ mod_prevalence_call_combined_prev_estimator <- function( #' #' Invoke mwana's prevalence functions from within module server according to #' user specifications in the UI -#' -#' @param df,age,muac,oedema,area1,area2,area3 Input variables collected -#' from the UI and required to pass to mwana::mw_estimate_prevalence_screening(). +#' +#' @param df,age,muac,oedema,area1,area2,area3 Input variables collected +#' from the UI and required to pass to mwana::mw_estimate_prevalence_screening(). # -#' @returns A summary tibble for the descriptive statistics about wasting based +#' @returns A summary tibble for the descriptive statistics about wasting based #' on MUAC, with no confidence intervals. #' #' @keywords internal #' #' mod_prevalence_call_prev_estimator_screening <- function( - df, age, muac, oedema = NULL, - area1, area2, area3) { + df, + age, + muac, + oedema = NULL, + area1, + area2, + area3 +) { dots <- list() - if (nzchar(area1)) dots <- c(dots, list(rlang::sym(area1))) else NULL - if (nzchar(area2)) dots <- c(dots, list(rlang::sym(area2))) - if (nzchar(area3)) dots <- c(dots, list(rlang::sym(area3))) + if (nzchar(area1)) { + dots <- c(dots, list(rlang::sym(area1))) + } else { + NULL + } + if (nzchar(area2)) { + dots <- c(dots, list(rlang::sym(area2))) + } + if (nzchar(area3)) { + dots <- c(dots, list(rlang::sym(area3))) + } df <- dplyr::mutate(df, muac = !!rlang::sym(muac) * 10) @@ -317,21 +402,35 @@ mod_prevalence_call_prev_estimator_screening <- function( #' Invoke mwana's prevalence functions from within module server according to #' user specifications in the UI #' -#' @param df,age_cat,muac,oedema,area1,area2,area3 Input variables collected +#' @param df,age_cat,muac,oedema,area1,area2,area3 Input variables collected #' from the UI and required to pass to mwana::mw_estimate_prevalence_screening2() -#' -#' @returns A summary tibble for the descriptive statistics about wasting based +#' +#' @returns A summary tibble for the descriptive statistics about wasting based #' on MUAC, with no confidence intervals. #' #' @keywords internal #' mod_prevalence_call_prev_estimator_screening2 <- function( - df, age_cat, muac, oedema = NULL, - area1, area2, area3) { + df, + age_cat, + muac, + oedema = NULL, + area1, + area2, + area3 +) { dots <- list() - if (nzchar(area1)) dots <- c(dots, list(rlang::sym(area1))) else NULL - if (nzchar(area2)) dots <- c(dots, list(rlang::sym(area2))) - if (nzchar(area3)) dots <- c(dots, list(rlang::sym(area3))) + if (nzchar(area1)) { + dots <- c(dots, list(rlang::sym(area1))) + } else { + NULL + } + if (nzchar(area2)) { + dots <- c(dots, list(rlang::sym(area2))) + } + if (nzchar(area3)) { + dots <- c(dots, list(rlang::sym(area3))) + } # Create the call - pass oedema as NULL or as a symbol if (nzchar(oedema)) { @@ -358,25 +457,28 @@ mod_prevalence_call_prev_estimator_screening2 <- function( #' #' #' Neat prevalence output from survey -#' +#' #' @param df data.frame containing the prevalence results. #' @param .type A choice from which the prevalence is derived. -#' -#' @returns A tibble object of the same length and width as df, with column +#' +#' @returns A tibble object of the same length and width as df, with column #' names and values formatted for clarity and readability. -#' +#' #' @keywords internal #' #' mod_prevalence_neat_output_survey <- function( - df, - .type = c("wfhz", "muac", "combined")) { + df, + .type = c("wfhz", "muac", "combined") +) { df <- dplyr::mutate( .data = df, dplyr::across( .cols = dplyr::ends_with(c("am_p", "am_p_low", "am_p_upp")), .fns = scales::label_percent( - accuracy = 0.1, suffix = "%", decimal.mark = "." + accuracy = 0.1, + suffix = "%", + decimal.mark = "." ) ) ) @@ -429,12 +531,12 @@ mod_prevalence_neat_output_survey <- function( #' -#' +#' #' Neat prevalence output from survey -#' +#' #' @param df data.frame containing the prevalence results. -#' -#' @returns A tibble object of the same length and width as df, with column +#' +#' @returns A tibble object of the same length and width as df, with column #' names and values formatted for clarity and readability. #' #' @keywords internal diff --git a/man/mwanaApp-package.Rd b/man/mwanaApp-package.Rd index 180f19b..e514e8e 100644 --- a/man/mwanaApp-package.Rd +++ b/man/mwanaApp-package.Rd @@ -6,7 +6,7 @@ \alias{mwanaApp-package} \title{mwanaApp: mwana GUI} \description{ -A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation. +A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation of wasting. } \seealso{ Useful links: From a64e3bacbce4fb8d4b6cfe51decda9f1af207ef9 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Fri, 31 Jul 2026 18:23:13 +0200 Subject: [PATCH 14/30] rename 'Screening' to 'Screening & Sentinel Site' --- R/module-prevalence.R | 109 +++++++++++++++++++++++++++++++----------- 1 file changed, 81 insertions(+), 28 deletions(-) diff --git a/R/module-prevalence.R b/R/module-prevalence.R index 6b066ff..120ff5c 100644 --- a/R/module-prevalence.R +++ b/R/module-prevalence.R @@ -24,7 +24,8 @@ 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;" ) ), @@ -32,12 +33,13 @@ module_ui_prevalence <- function(id) { #### 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 @@ -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;" ) ), @@ -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;" )) ) @@ -97,7 +102,6 @@ module_ui_prevalence <- function(id) { ## ---- Module: Server --------------------------------------------------------- - #' #' #' Module server for prevalence analysis @@ -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( @@ -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"), @@ -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 ) }) @@ -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(), @@ -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, @@ -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, @@ -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( @@ -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" ) } ) @@ -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({ @@ -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 = "" + ) } } }, @@ -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" + ) } ) } From db0c5aa0ccf6c1843e7287284883122788e8cef6 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Fri, 31 Jul 2026 19:03:19 +0200 Subject: [PATCH 15/30] update user guide --- inst/app/ui.R | 39 ++++++++++++++++++++++++++++++++++----- 1 file changed, 34 insertions(+), 5 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 36e1689..964d497 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -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( @@ -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") ) @@ -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 @@ -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." ) ) ) From 8eb43aa6fba1b237954f91af06b7cff1ad4bc721 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Fri, 31 Jul 2026 19:20:43 +0200 Subject: [PATCH 16/30] Close #50 --- inst/app/ui.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/inst/app/ui.R b/inst/app/ui.R index 964d497..81e24a8 100644 --- a/inst/app/ui.R +++ b/inst/app/ui.R @@ -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( @@ -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")), @@ -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"), @@ -310,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 From c4e317691e8b83134d884f4365070082d31f2eaf Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Fri, 31 Jul 2026 21:35:54 +0200 Subject: [PATCH 17/30] Close #45 --- R/module-helpers-prevalence.R | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/R/module-helpers-prevalence.R b/R/module-helpers-prevalence.R index 2f4564d..bf7fb71 100644 --- a/R/module-helpers-prevalence.R +++ b/R/module-helpers-prevalence.R @@ -65,28 +65,32 @@ mod_prevalence_display_input_variables <- function( ) ), choices = c("", vars) - ), - shiny::selectInput( - inputId = ns("wts"), - label = shiny::tagList( - htmltools::tags$span( - "Survey weights", - style = "font-size: 14px; font-weight: bold;" - ), - htmltools::tags$div( - style = "font-size: 0.85em; color: #6c7574;", - "Final survey weights for weighted analysis" - ) - ), - choices = c("", vars) ) ) #### Conditional inputs depending on source of data ---- if (source == "survey") { inputs <- c( + ##### Display grouping variables ---- inputs, + list( + ##### Display input variable for survey weights ---- + shiny::selectInput( + inputId = ns("wts"), + label = shiny::tagList( + htmltools::tags$span( + "Survey weights", + style = "font-size: 14px; font-weight: bold;" + ), + htmltools::tags$div( + style = "font-size: 0.85em; color: #6c7574;", + "Final survey weights for weighted analysis" + ) + ), + choices = c("", vars) + ), + if (isTRUE(indicator_surv == "muac")) { #### Display age ---- shiny::tagList( From 4e734c24247ec1a1ee8cf051c7dfabc2fdc68638 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Wed, 2 Sep 2026 20:46:21 +0200 Subject: [PATCH 18/30] remove reference to remotes:mwana --- DESCRIPTION | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0f4bb1e..a2021cd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ URL: https://github.com/mphimo/mwanaApp, https://mphimo.github.io/mwanaApp/ BugReports: https://github.com/mphimo/mwanaApp/issues Imports: dplyr (>= 1.1.4), - mwana (>= 0.2.3), + mwana (>= 0.2.5), rlang, shiny (>= 1.11.1), shinycssloaders (>= 1.1.0), @@ -38,8 +38,6 @@ Suggests: testthat (>= 3.0.0), shinytest2 (>= 0.4.1), stringr (>= 1.6.0) -Remotes: - mphimo/mwana Config/testthat/edition: 3 Depends: R (>= 4.1.0) From b4404dbe68287a039d371ff240734d4b70c91d28 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Wed, 2 Sep 2026 20:46:48 +0200 Subject: [PATCH 19/30] Increment version number to 0.2.2 --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a2021cd..0202592 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: mwanaApp Title: mwana GUI -Version: 0.2.1 +Version: 0.2.2 Authors@R: person(given = "Tomás", family = "Zaba", diff --git a/NEWS.md b/NEWS.md index f26b870..66a07dd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# mwanaApp 0.2.2 + # mwanaApp 0.2.1 ### Bug fixes From 86dfcbd233dac0c38cfcc2f2de94603046c0d7f8 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Wed, 2 Sep 2026 20:52:27 +0200 Subject: [PATCH 20/30] update citation --- .Rbuildignore | 2 +- CITATION.cff | 430 ++++++++++++++++++++++++++++++++++++++++++++++++++ README.md | 4 +- inst/CITATION | 2 +- 4 files changed, 434 insertions(+), 4 deletions(-) create mode 100644 CITATION.cff diff --git a/.Rbuildignore b/.Rbuildignore index e262b35..cb1ea78 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -3,5 +3,5 @@ ^\.github$ ^LICENSE\.md$ ^quarto\.qmd$ -^quarto\.qmd$ ^README\.qmd$ +^CITATION\.cff$ diff --git a/CITATION.cff b/CITATION.cff new file mode 100644 index 0000000..b3f436e --- /dev/null +++ b/CITATION.cff @@ -0,0 +1,430 @@ +# ------------------------------------------------ +# CITATION.cff file created with {cffr} R package +# See also: https://docs.ropensci.org/cffr/ +# ------------------------------------------------ + +cff-version: 1.2.0 +message: 'To cite package "mwanaApp" in publications use:' +type: software +license: GPL-3.0-or-later +title: 'mwanaApp: mwana GUI' +version: 0.2.2 +abstract: A seamless graphical interface to the mwana R package for data wrangling, + plausibility checks, and prevalence estimation of wasting. +authors: +- family-names: Zaba + given-names: Tomás + email: tomas.zaba@outlook.com + orcid: https://orcid.org/0000-0002-7079-3574 +preferred-citation: + type: manual + title: 'mwanaApp: A seamless graphical interface to the mwana R package for data + wrangling, plausibility checks, and prevalence estimation of wasting' + authors: + - name: Tomás Zaba + year: '2026' + notes: R package version 0.2.2 + url: https://github.com/mphimo/mwanaApp +repository-code: https://github.com/mphimo/mwanaApp +url: https://mphimo.github.io/mwanaApp/ +contact: +- family-names: Zaba + given-names: Tomás + email: tomas.zaba@outlook.com + orcid: https://orcid.org/0000-0002-7079-3574 +keywords: +- acute-malnutrition +- anthropometry +- wasting +references: +- type: software + title: dplyr + abstract: 'dplyr: A Grammar of Data Manipulation' + notes: Imports + url: https://dplyr.tidyverse.org + repository: https://CRAN.R-project.org/package=dplyr + authors: + - family-names: Wickham + given-names: Hadley + email: hadley@posit.co + orcid: https://orcid.org/0000-0003-4757-117X + - family-names: François + given-names: Romain + orcid: https://orcid.org/0000-0002-2444-4226 + - family-names: Henry + given-names: Lionel + - family-names: Müller + given-names: Kirill + orcid: https://orcid.org/0000-0002-1416-3412 + - family-names: Vaughan + given-names: Davis + email: davis@posit.co + orcid: https://orcid.org/0000-0003-4777-038X + year: '2026' + doi: 10.32614/CRAN.package.dplyr + version: '>= 1.1.4' +- type: software + title: mwana + abstract: 'mwana: An Efficient Workflow for Plausibility Checks and Prevalence Analysis + of Wasting in R' + notes: Imports + url: https://mphimo.github.io/mwana/ + repository: https://CRAN.R-project.org/package=mwana + authors: + - family-names: Zaba + given-names: Tomás + email: tomas.zaba@outlook.com + orcid: https://orcid.org/0000-0002-7079-3574 + - family-names: Guevarra + given-names: Ernest + orcid: https://orcid.org/0000-0002-4887-4415 + - family-names: Myatt + given-names: Mark + year: '2026' + doi: 10.32614/CRAN.package.mwana + version: '>= 0.2.5' +- type: software + title: rlang + abstract: 'rlang: Functions for Base Types and Core R and ''Tidyverse'' Features' + notes: Imports + url: https://rlang.r-lib.org + repository: https://CRAN.R-project.org/package=rlang + authors: + - family-names: Henry + given-names: Lionel + email: lionel@posit.co + - family-names: Wickham + given-names: Hadley + email: hadley@posit.co + year: '2026' + doi: 10.32614/CRAN.package.rlang +- type: software + title: shiny + abstract: 'shiny: Web Application Framework for R' + notes: Imports + url: https://shiny.posit.co/ + repository: https://CRAN.R-project.org/package=shiny + authors: + - family-names: Chang + given-names: Winston + email: winston@posit.co + orcid: https://orcid.org/0000-0002-1576-2126 + - family-names: Cheng + given-names: Joe + email: joe@posit.co + - family-names: Allaire + given-names: JJ + email: jj@posit.co + - family-names: Sievert + given-names: Carson + email: carson@posit.co + orcid: https://orcid.org/0000-0002-4958-2844 + - family-names: Schloerke + given-names: Barret + email: barret@posit.co + orcid: https://orcid.org/0000-0001-9986-114X + - family-names: Aden-Buie + given-names: Garrick + email: garrick@adenbuie.com + orcid: https://orcid.org/0000-0002-7111-0077 + - family-names: Xie + given-names: Yihui + email: yihui@posit.co + - family-names: Allen + given-names: Jeff + - family-names: McPherson + given-names: Jonathan + email: jonathan@posit.co + - family-names: Dipert + given-names: Alan + - family-names: Borges + given-names: Barbara + year: '2026' + doi: 10.32614/CRAN.package.shiny + version: '>= 1.11.1' +- type: software + title: shinycssloaders + abstract: 'shinycssloaders: Add Loading Animations to a ''shiny'' Output While It''s + Recalculating' + notes: Imports + url: https://daattali.com/shiny/shinycssloaders-demo/ + repository: https://CRAN.R-project.org/package=shinycssloaders + authors: + - family-names: Attali + given-names: Dean + email: daattali@gmail.com + orcid: https://orcid.org/0000-0002-5645-3493 + - family-names: Sali + given-names: Andras + email: andras.sali@alphacruncher.hu + year: '2026' + doi: 10.32614/CRAN.package.shinycssloaders + version: '>= 1.1.0' +- type: software + title: bslib + abstract: 'bslib: Custom ''Bootstrap'' ''Sass'' Themes for ''shiny'' and ''rmarkdown''' + notes: Imports + url: https://rstudio.github.io/bslib/ + repository: https://CRAN.R-project.org/package=bslib + authors: + - family-names: Sievert + given-names: Carson + email: carson@posit.co + orcid: https://orcid.org/0000-0002-4958-2844 + - family-names: Cheng + given-names: Joe + email: joe@posit.co + - family-names: Aden-Buie + given-names: Garrick + email: garrick@posit.co + orcid: https://orcid.org/0000-0002-7111-0077 + year: '2026' + doi: 10.32614/CRAN.package.bslib + version: '>= 0.9.0' +- type: software + title: openxlsx + abstract: 'openxlsx: Read, Write and Edit xlsx Files' + notes: Imports + url: https://ycphs.github.io/openxlsx/index.html + repository: https://CRAN.R-project.org/package=openxlsx + authors: + - family-names: Schauberger + given-names: Philipp + email: philipp@schauberger.co.at + - family-names: Walker + given-names: Alexander + email: Alexander.Walker1989@gmail.com + year: '2026' + doi: 10.32614/CRAN.package.openxlsx + version: '>= 4.2.8.1' +- type: software + title: DT + abstract: 'DT: A Wrapper of the JavaScript Library ''DataTables''' + notes: Imports + url: https://github.com/rstudio/DT + repository: https://CRAN.R-project.org/package=DT + authors: + - family-names: Xie + given-names: Yihui + - family-names: Cheng + given-names: Joe + email: joe@posit.co + - family-names: Tan + given-names: Xianying + - family-names: Aden-Buie + given-names: Garrick + email: garrick@posit.co + orcid: https://orcid.org/0000-0002-7111-0077 + year: '2026' + doi: 10.32614/CRAN.package.DT +- type: software + title: htmltools + abstract: 'htmltools: Tools for HTML' + notes: Imports + url: https://rstudio.github.io/htmltools/ + repository: https://CRAN.R-project.org/package=htmltools + authors: + - family-names: Cheng + given-names: Joe + email: joe@posit.co + - family-names: Sievert + given-names: Carson + email: carson@posit.co + orcid: https://orcid.org/0000-0002-4958-2844 + - family-names: Schloerke + given-names: Barret + email: barret@posit.co + orcid: https://orcid.org/0000-0001-9986-114X + - family-names: Chang + given-names: Winston + email: winston@posit.co + orcid: https://orcid.org/0000-0002-1576-2126 + - family-names: Xie + given-names: Yihui + email: yihui@posit.co + - family-names: Allen + given-names: Jeff + year: '2026' + doi: 10.32614/CRAN.package.htmltools + version: '>= 0.5.8.1' +- type: software + title: scales + abstract: 'scales: Scale Functions for Visualization' + notes: Imports + url: https://scales.r-lib.org + repository: https://CRAN.R-project.org/package=scales + authors: + - family-names: Wickham + given-names: Hadley + email: hadley@posit.co + - family-names: Pedersen + given-names: Thomas Lin + email: thomas.pedersen@posit.co + orcid: https://orcid.org/0000-0002-5147-4711 + - family-names: Seidel + given-names: Dana + year: '2026' + doi: 10.32614/CRAN.package.scales + version: '>= 1.4.0' +- type: software + title: covr + abstract: 'covr: Test Coverage for Packages' + notes: Suggests + url: https://covr.r-lib.org + repository: https://CRAN.R-project.org/package=covr + authors: + - family-names: Hester + given-names: Jim + email: james.f.hester@gmail.com + year: '2026' + doi: 10.32614/CRAN.package.covr + version: '>= 3.6.4' +- type: software + title: knitr + abstract: 'knitr: A General-Purpose Package for Dynamic Report Generation in R' + notes: Suggests + url: https://yihui.org/knitr/ + repository: https://CRAN.R-project.org/package=knitr + authors: + - family-names: Xie + given-names: Yihui + email: xie@yihui.name + orcid: https://orcid.org/0000-0003-0645-5666 + year: '2026' + doi: 10.32614/CRAN.package.knitr + version: '>= 1.50' +- type: software + title: rmarkdown + abstract: 'rmarkdown: Dynamic Documents for R' + notes: Suggests + url: https://pkgs.rstudio.com/rmarkdown/ + repository: https://CRAN.R-project.org/package=rmarkdown + authors: + - family-names: Allaire + given-names: JJ + email: jj@posit.co + - family-names: Xie + given-names: Yihui + email: xie@yihui.name + orcid: https://orcid.org/0000-0003-0645-5666 + - family-names: Dervieux + given-names: Christophe + email: cderv@posit.co + orcid: https://orcid.org/0000-0003-4474-2498 + - family-names: McPherson + given-names: Jonathan + email: jonathan@posit.co + - family-names: Luraschi + given-names: Javier + - family-names: Ushey + given-names: Kevin + email: kevin@posit.co + - family-names: Atkins + given-names: Aron + email: aron@posit.co + - family-names: Wickham + given-names: Hadley + email: hadley@posit.co + - family-names: Cheng + given-names: Joe + email: joe@posit.co + - family-names: Chang + given-names: Winston + email: winston@posit.co + - family-names: Iannone + given-names: Richard + email: rich@posit.co + orcid: https://orcid.org/0000-0003-3925-190X + year: '2026' + doi: 10.32614/CRAN.package.rmarkdown + version: '>= 2.30' +- type: software + title: quarto + abstract: 'quarto: R Interface to ''Quarto'' Markdown Publishing System' + notes: Suggests + url: https://quarto-dev.github.io/quarto-r/ + repository: https://CRAN.R-project.org/package=quarto + authors: + - family-names: Allaire + given-names: JJ + email: jj@posit.co + orcid: https://orcid.org/0000-0003-0174-9868 + - family-names: Dervieux + given-names: Christophe + email: cderv@posit.co + orcid: https://orcid.org/0000-0003-4474-2498 + year: '2026' + doi: 10.32614/CRAN.package.quarto + version: '>= 1.4.4' +- type: software + title: spelling + abstract: 'spelling: Tools for Spell Checking in R' + notes: Suggests + url: https://ropensci.r-universe.dev/spelling + repository: https://CRAN.R-project.org/package=spelling + authors: + - family-names: Ooms + given-names: Jeroen + email: jeroenooms@gmail.com + orcid: https://orcid.org/0000-0002-4035-0289 + - family-names: Hester + given-names: Jim + email: james.hester@rstudio.com + year: '2026' + doi: 10.32614/CRAN.package.spelling + version: '>= 2.3.1' +- type: software + title: testthat + abstract: 'testthat: Unit Testing for R' + notes: Suggests + url: https://testthat.r-lib.org + repository: https://CRAN.R-project.org/package=testthat + authors: + - family-names: Wickham + given-names: Hadley + email: hadley@posit.co + year: '2026' + doi: 10.32614/CRAN.package.testthat + version: '>= 3.0.0' +- type: software + title: shinytest2 + abstract: 'shinytest2: Testing for Shiny Applications' + notes: Suggests + url: https://rstudio.github.io/shinytest2/ + repository: https://CRAN.R-project.org/package=shinytest2 + authors: + - family-names: Schloerke + given-names: Barret + email: barret@posit.co + orcid: https://orcid.org/0000-0001-9986-114X + year: '2026' + doi: 10.32614/CRAN.package.shinytest2 + version: '>= 0.4.1' +- type: software + title: stringr + abstract: 'stringr: Simple, Consistent Wrappers for Common String Operations' + notes: Suggests + url: https://stringr.tidyverse.org + repository: https://CRAN.R-project.org/package=stringr + authors: + - family-names: Wickham + given-names: Hadley + email: hadley@posit.co + year: '2026' + doi: 10.32614/CRAN.package.stringr + version: '>= 1.6.0' +- type: software + title: 'R: A Language and Environment for Statistical Computing' + notes: Depends + url: https://www.R-project.org/ + authors: + - name: R Core Team + website: https://ror.org/02zz1nj61 + institution: + name: R Foundation for Statistical Computing + website: https://ror.org/05qewa988 + address: Vienna, Austria + year: '2026' + doi: 10.32614/R.manuals + version: '>= 4.1.0' + diff --git a/README.md b/README.md index 29d41c6..0e75f1b 100644 --- a/README.md +++ b/README.md @@ -54,7 +54,7 @@ citation("mwanaApp") Tomás Zaba (2026). _mwanaApp: A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and - prevalence estimation of wasting_. R package version 0.2.1, + prevalence estimation of wasting_. R package version 0.2.2, . A BibTeX entry for LaTeX users is @@ -63,6 +63,6 @@ citation("mwanaApp") title = {mwanaApp: A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation of wasting}, author = {{Tomás Zaba}}, year = {2026}, - note = {R package version 0.2.1}, + note = {R package version 0.2.2}, url = {https://github.com/mphimo/mwanaApp}, } diff --git a/inst/CITATION b/inst/CITATION index ccf4fdb..de66d16 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -4,6 +4,6 @@ bibentry( title = "mwanaApp: A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation of wasting", author = person("Tomás Zaba"), year = 2026, - note = "R package version 0.2.1", + note = "R package version 0.2.2", url = "https://github.com/mphimo/mwanaApp" ) From 6b16c0aa3aa90fb0ddb7c25b5fd630c494c90bbf Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Wed, 2 Sep 2026 21:10:23 +0200 Subject: [PATCH 21/30] update news --- NEWS.md | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 66a07dd..49b400d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,15 @@ -# mwanaApp 0.2.2 +# mwanaApp 0.2.2 + +### Bug fixes + ++ Removed the survey weights input field from the prevalence module's UI when +the selected data source is "screening" or "sentinel" (it is now shown only +for the "survey" source) (#45). + +### General updates ++ Revised user-guide documentation to enhance clarity on type and format of the +input variables to the app. ++ Updated hyperlinks to open in a new browser tab. # mwanaApp 0.2.1 From 159d1e65ca46f9d32f945da5c89cdea585c49e97 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Wed, 2 Sep 2026 21:37:42 +0200 Subject: [PATCH 22/30] remove non-existing website link; change package title --- DESCRIPTION | 8 ++++---- man/mwanaApp-package.Rd | 1 - 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0202592..bc316f2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: mwanaApp -Title: mwana GUI +Title: Graphical User Interface to 'mwana' Version: 0.2.2 Authors@R: person(given = "Tomás", @@ -8,15 +8,14 @@ Authors@R: email = "tomas.zaba@outlook.com", comment = c(ORCID = "0000-0002-7079-3574") ) -Description: A seamless graphical interface to the mwana R package for data +Description: A seamless graphical interface to the 'mwana' R package for data wrangling, plausibility checks, and prevalence estimation of wasting. License: GPL (>= 3) Encoding: UTF-8 LazyData: true Language: en-GB Roxygen: list(markdown = TRUE) -RoxygenNote: 8.0.0 -URL: https://github.com/mphimo/mwanaApp, https://mphimo.github.io/mwanaApp/ +URL: https://github.com/mphimo/mwanaApp BugReports: https://github.com/mphimo/mwanaApp/issues Imports: dplyr (>= 1.1.4), @@ -41,3 +40,4 @@ Suggests: Config/testthat/edition: 3 Depends: R (>= 4.1.0) +Config/roxygen2/version: 8.1.0 diff --git a/man/mwanaApp-package.Rd b/man/mwanaApp-package.Rd index e514e8e..a9718ab 100644 --- a/man/mwanaApp-package.Rd +++ b/man/mwanaApp-package.Rd @@ -12,7 +12,6 @@ A seamless graphical interface to the mwana R package for data wrangling, plausi Useful links: \itemize{ \item \url{https://github.com/mphimo/mwanaApp} - \item \url{https://mphimo.github.io/mwanaApp/} \item Report bugs at \url{https://github.com/mphimo/mwanaApp/issues} } From 33a9c446cd84fb14d1c754b06ee44bec33d0c96f Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 15:55:39 +0200 Subject: [PATCH 23/30] remove oedema in screening-based system test for having NAs --- tests/testthat/test-module-prevalence.R | 1394 +++++++++++------------ 1 file changed, 691 insertions(+), 703 deletions(-) diff --git a/tests/testthat/test-module-prevalence.R b/tests/testthat/test-module-prevalence.R index a618553..5292d73 100644 --- a/tests/testthat/test-module-prevalence.R +++ b/tests/testthat/test-module-prevalence.R @@ -2,789 +2,777 @@ # Test Suite: Module Prevalence # ============================================================================== - ## ---- Survey data ------------------------------------------------------------ - ### WFHZ weighted prevalence ---- -testthat::test_that( - desc = "Module works well to estimate weighted-WFHZ prevalence from survey", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) - - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) - - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - data["sex"] <- ifelse(data$sex == 1, "m", "f") - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ## App defaults to WFHZ ---- - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) - app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - Sys.sleep(3) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) - - ### Select the method ---- - app$set_inputs(`prevalence-amn_method_survey` = "wfhz", wait_ = FALSE) - app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) - app$set_inputs(`prevalence-wts` = "wtfactor", wait_ = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +testthat::test_that(desc = "Module works well to estimate weighted-WFHZ prevalence from survey", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + data["sex"] <- ifelse(data$sex == 1, "m", "f") + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ## App defaults to WFHZ ---- + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) + app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + Sys.sleep(3) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) + + ### Select the method ---- + app$set_inputs(`prevalence-amn_method_survey` = "wfhz", wait_ = FALSE) + app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) + app$set_inputs(`prevalence-wts` = "wtfactor", wait_ = FALSE) + app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Capture prevalence results of Nampula Province, Rural Strata ---- - glued_results <- app$get_js(js_values)[[3]] - weighted_pop <- sub("1", "", stringr::str_extract(glued_results, "\\d{7}(?:)")) - gam_prev <- stringr::str_extract(glued_results, "\\d\\.\\d") + ### Capture prevalence results of Nampula Province, Rural Strata ---- + glued_results <- app$get_js(js_values)[[3]] + weighted_pop <- sub( + "1", + "", + stringr::str_extract(glued_results, "\\d{7}(?:)") + ) + gam_prev <- stringr::str_extract(glued_results, "\\d\\.\\d") - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) - testthat::expect_equal(as.numeric(weighted_pop), 292611) - testthat::expect_equal(as.numeric(gam_prev), 6.1) + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) + testthat::expect_equal(as.numeric(weighted_pop), 292611) + testthat::expect_equal(as.numeric(gam_prev), 6.1) - ### Stop the app ---- - app$stop() - } -) + ### Stop the app ---- + app$stop() +}) ### WFHZ unweighted prevalence ---- -testthat::test_that( - desc = "Module works well to estimate unweighted-WFHZ prevalence from survey", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) - - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) - - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - data["sex"] <- ifelse(data$sex == 1, "m", "f") - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ## App defaults to WFHZ ---- - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) - app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - Sys.sleep(3) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) - - ### Select the method ---- - app$set_inputs(`prevalence-amn_method_survey` = "wfhz", wait_ = FALSE) - app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) - app$set_inputs(`prevalence-wts` = "", wait_ = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +testthat::test_that(desc = "Module works well to estimate unweighted-WFHZ prevalence from survey", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + data["sex"] <- ifelse(data$sex == 1, "m", "f") + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ## App defaults to WFHZ ---- + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) + app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + Sys.sleep(3) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) + + ### Select the method ---- + app$set_inputs(`prevalence-amn_method_survey` = "wfhz", wait_ = FALSE) + app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) + app$set_inputs(`prevalence-wts` = "", wait_ = FALSE) + app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Capture prevalence results of Nampula Province, Rural Strata ---- - glued_results <- app$get_js(js_values)[[3]] - pop <- sub("1", "", stringr::str_extract(glued_results, "\\d{4}")) - gam_prev <- stringr::str_extract(glued_results, "\\d{1}\\.\\d") + ### Capture prevalence results of Nampula Province, Rural Strata ---- + glued_results <- app$get_js(js_values)[[3]] + pop <- sub("1", "", stringr::str_extract(glued_results, "\\d{4}")) + gam_prev <- stringr::str_extract(glued_results, "\\d{1}\\.\\d") - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) - testthat::expect_equal(as.numeric(pop), 280) - testthat::expect_equal(as.numeric(gam_prev), 6.1) + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) + testthat::expect_equal(as.numeric(pop), 280) + testthat::expect_equal(as.numeric(gam_prev), 6.1) - ### Stop the app ---- - app$stop() - } -) + ### Stop the app ---- + app$stop() +}) ### MUAC weighted prevalence ---- -testthat::test_that( - desc = "Module works well to estimate weighted-MUAC prevalence from survey", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) - - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) - - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - data["sex"] <- ifelse(data$sex == 1, "m", "f") - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method and wait the app till idles ---- - app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE) - app$wait_for_idle(timeout = 40000) - - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) - - ### Select the method ---- - app$set_inputs(`prevalence-amn_method_survey` = "muac", wait_ = TRUE) - app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) - app$set_inputs(`prevalence-muac` = "muac", wait_ = FALSE) - app$set_inputs(`prevalence-age` = "age", wait_ = FALSE) - app$set_inputs(`prevalence-wts` = "wtfactor", wait_ = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +testthat::test_that(desc = "Module works well to estimate weighted-MUAC prevalence from survey", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + data["sex"] <- ifelse(data$sex == 1, "m", "f") + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method and wait the app till idles ---- + app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE) + app$wait_for_idle(timeout = 40000) + + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) + + ### Select the method ---- + app$set_inputs(`prevalence-amn_method_survey` = "muac", wait_ = TRUE) + app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) + app$set_inputs(`prevalence-muac` = "muac", wait_ = FALSE) + app$set_inputs(`prevalence-age` = "age", wait_ = FALSE) + app$set_inputs(`prevalence-wts` = "wtfactor", wait_ = FALSE) + app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Get a JS expression ---- - js_result <- app$get_js(js_values) + ### Get a JS expression ---- + js_result <- app$get_js(js_values) - ### Wait/validate that we have at least 3 values - if (length(js_result) < 4) { - #### Add a small delay and retry - Sys.sleep(3) - js_result <- app$get_js(js_values) - } - ### Capture prevalence results of Zambezia Province, Rural Strata ---- - prev <- stringr::str_extract_all(js_result[[3]], "\\d\\.\\d")[[1]] - weighted_pop <- sub("1", "", stringr::str_extract(js_result[[3]], "\\d{7}(?:)")) - - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) - testthat::expect_equal(as.numeric(prev[2]), 7.7) # GAM - testthat::expect_equal(as.numeric(weighted_pop), 307395) - - ### Stop the app ---- - app$stop() + ### Wait/validate that we have at least 3 values + if (length(js_result) < 4) { + #### Add a small delay and retry + Sys.sleep(3) + js_result <- app$get_js(js_values) } -) + ### Capture prevalence results of Zambezia Province, Rural Strata ---- + prev <- stringr::str_extract_all(js_result[[3]], "\\d\\.\\d")[[1]] + weighted_pop <- sub( + "1", + "", + stringr::str_extract(js_result[[3]], "\\d{7}(?:)") + ) + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) + testthat::expect_equal(as.numeric(prev[2]), 7.7) # GAM + testthat::expect_equal(as.numeric(weighted_pop), 307395) -### MUAC unweighted prevalence ---- -testthat::test_that( - desc = "Module works well to estimate unweighted-MUAC prevalence from survey", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) + ### Stop the app ---- + app$stop() +}) - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - data["sex"] <- ifelse(data$sex == 1, "m", "f") - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method and wait the app till idles ---- - app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE) - app$wait_for_idle(timeout = 40000) - - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) - - ### Select the method ---- - app$set_inputs(`prevalence-amn_method_survey` = "muac", wait_ = TRUE) - app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) - app$set_inputs(`prevalence-muac` = "muac", wait_ = FALSE) - app$set_inputs(`prevalence-age` = "age", wait_ = FALSE) - app$set_inputs(`prevalence-wts` = "", wait_ = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +### MUAC unweighted prevalence ---- +testthat::test_that(desc = "Module works well to estimate unweighted-MUAC prevalence from survey", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + data["sex"] <- ifelse(data$sex == 1, "m", "f") + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method and wait the app till idles ---- + app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE) + app$wait_for_idle(timeout = 40000) + + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) + + ### Select the method ---- + app$set_inputs(`prevalence-amn_method_survey` = "muac", wait_ = TRUE) + app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) + app$set_inputs(`prevalence-muac` = "muac", wait_ = FALSE) + app$set_inputs(`prevalence-age` = "age", wait_ = FALSE) + app$set_inputs(`prevalence-wts` = "", wait_ = FALSE) + app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Get a JS expression ---- - js_result <- app$get_js(js_values) + ### Get a JS expression ---- + js_result <- app$get_js(js_values) - ### Wait/validate that we have at least 3 values - if (length(js_result) < 4) { - #### Add a small delay and retry - Sys.sleep(3) - js_result <- app$get_js(js_values) - } - ### Capture prevalence results of Zambezia Province, Rural Strata ---- - pop <- sub("1", "", stringr::str_extract(js_result[[3]], "\\d{4}")) - prev <- stringr::str_extract(js_result[[3]], "\\d{1}\\.\\d") - - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) - testthat::expect_equal(as.numeric(prev), 8.0) # GAM - testthat::expect_equal(as.numeric(pop), 300) - - ### Stop the app ---- - app$stop() + ### Wait/validate that we have at least 3 values + if (length(js_result) < 4) { + #### Add a small delay and retry + Sys.sleep(3) + js_result <- app$get_js(js_values) } -) - + ### Capture prevalence results of Zambezia Province, Rural Strata ---- + pop <- sub("1", "", stringr::str_extract(js_result[[3]], "\\d{4}")) + prev <- stringr::str_extract(js_result[[3]], "\\d{1}\\.\\d") + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) + testthat::expect_equal(as.numeric(prev), 8.0) # GAM + testthat::expect_equal(as.numeric(pop), 300) -### Combined weighted prevalence ---- -testthat::test_that( - desc = "Module works well to estimate weighted-combined prevalence from survey", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) - - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) + ### Stop the app ---- + app$stop() +}) - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - data["sex"] <- ifelse(data$sex == 1, "m", "f") - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method and wait the app till idles ---- - app$set_inputs(`wrangle_data-wrangle` = "combined", wait_ = TRUE) - app$wait_for_idle(timeout = 40000) - - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) - app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) - - ### Select the method ---- - app$set_inputs(`prevalence-amn_method_survey` = "combined", wait_ = TRUE) - app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) - app$set_inputs(`prevalence-wts` = "wtfactor", wait_ = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +### Combined weighted prevalence ---- +testthat::test_that(desc = "Module works well to estimate weighted-combined prevalence from survey", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + data["sex"] <- ifelse(data$sex == 1, "m", "f") + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method and wait the app till idles ---- + app$set_inputs(`wrangle_data-wrangle` = "combined", wait_ = TRUE) + app$wait_for_idle(timeout = 40000) + + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) + app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) + + ### Select the method ---- + app$set_inputs(`prevalence-amn_method_survey` = "combined", wait_ = TRUE) + app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) + app$set_inputs(`prevalence-wts` = "wtfactor", wait_ = FALSE) + app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Capture prevalence results of Nampula Province, Urban Strata ---- - glued_results <- app$get_js(js_values)[[3]] - prev <- stringr::str_extract_all(glued_results, "\\d{2}\\.\\d")[[1]] - weighted_pop <- sub("1", "", stringr::str_extract(glued_results, "\\d{7}(?:)")) + ### Capture prevalence results of Nampula Province, Urban Strata ---- + glued_results <- app$get_js(js_values)[[3]] + prev <- stringr::str_extract_all(glued_results, "\\d{2}\\.\\d")[[1]] + weighted_pop <- sub( + "1", + "", + stringr::str_extract(glued_results, "\\d{7}(?:)") + ) - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) - testthat::expect_equal(as.numeric(prev[2]), 10.8) # GAM - testthat::expect_equal(as.numeric(weighted_pop), 288534) + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) + testthat::expect_equal(as.numeric(prev[2]), 10.8) # GAM + testthat::expect_equal(as.numeric(weighted_pop), 288534) - ### Stop the app ---- - app$stop() - } -) + ### Stop the app ---- + app$stop() +}) ### Combined unweighted prevalence ---- -testthat::test_that( - desc = "Module works well to estimate unweighted-combined prevalence from survey", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) - - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) - - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - data["sex"] <- ifelse(data$sex == 1, "m", "f") - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method and wait the app till idles ---- - app$set_inputs(`wrangle_data-wrangle` = "combined", wait_ = TRUE) - app$wait_for_idle(timeout = 40000) - - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) - app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) - - ### Select the method ---- - app$set_inputs(`prevalence-amn_method_survey` = "combined", wait_ = TRUE) - app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) - app$set_inputs(`prevalence-wts` = "", wait_ = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +testthat::test_that(desc = "Module works well to estimate unweighted-combined prevalence from survey", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + data["sex"] <- ifelse(data$sex == 1, "m", "f") + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method and wait the app till idles ---- + app$set_inputs(`wrangle_data-wrangle` = "combined", wait_ = TRUE) + app$wait_for_idle(timeout = 40000) + + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) + app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs(`prevalence-source` = "survey", wait_ = FALSE) + + ### Select the method ---- + app$set_inputs(`prevalence-amn_method_survey` = "combined", wait_ = TRUE) + app$set_inputs(`prevalence-area1` = "province", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "strata", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "sex", wait_ = FALSE) + app$set_inputs(`prevalence-wts` = "", wait_ = FALSE) + app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Capture prevalence results of Nampula Province, Urban Strata ---- - glued_results <- app$get_js(js_values)[[3]] - pop <- sub("1", "", stringr::str_extract(glued_results, "\\d{4}")) - prev <- stringr::str_extract(glued_results, "\\d{2}\\.\\d") + ### Capture prevalence results of Nampula Province, Urban Strata ---- + glued_results <- app$get_js(js_values)[[3]] + pop <- sub("1", "", stringr::str_extract(glued_results, "\\d{4}")) + prev <- stringr::str_extract(glued_results, "\\d{2}\\.\\d") - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) - testthat::expect_equal(as.numeric(prev), 10.5) # GAM - testthat::expect_equal(as.numeric(pop), 276) + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) + testthat::expect_equal(as.numeric(prev), 10.5) # GAM + testthat::expect_equal(as.numeric(pop), 276) - ### Stop the app ---- - app$stop() - } -) + ### Stop the app ---- + app$stop() +}) ## ---- Screening data --------------------------------------------------------- - ### When age is available ---- -testthat::test_that( - desc = "Module works well to estimate prevalence from screening", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE - ) - - ### Wait the app to idle ---- - app$wait_for_idle(timeout = 40000) - - ### Click in the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-02.csv"), - check.names = FALSE - ) - ### Make age categories ---- - data <- data |> - transform(oedema = dplyr::recode_values(oedema, "n " ~ "n")) - - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method and wait the app till idles ---- - app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE) - app$wait_for_idle(timeout = 40000) - - ### Input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button and wait the app to idle ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Prevalence tab and wait the app to idle ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - ### Select source of data ---- - app$set_inputs(`prevalence-source` = "screening", wait_ = TRUE) - - ### Select the method ---- - app$set_inputs(`prevalence-has_age` = "yes", wait_ = TRUE) - app$set_inputs(`prevalence-area1` = "analysis_unit", wait_ = FALSE) - app$set_inputs(`prevalence-area2` = "sex", wait_ = FALSE) ## Assume sex as grouping var - app$set_inputs(`prevalence-area3` = "", wait_ = FALSE) - app$set_inputs(`prevalence-muac` = "muac", wait_ = FALSE) - app$set_inputs(`prevalence-age` = "age", wait = FALSE) - app$set_inputs(`prevalence-oedema` = "oedema", wait_ = FALSE) - - ### Click on Estime Prevalence button ---- - app$click(input = "prevalence-estimate") - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() +testthat::test_that(desc = "Module works well to estimate prevalence from screening", code = { + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + ### Wait the app to idle ---- + app$wait_for_idle(timeout = 40000) + + ### Click in the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-02.csv"), + check.names = FALSE + ) + ### Make age categories ---- + data <- data |> + transform(oedema = dplyr::recode_values(oedema, "n " ~ "n")) + + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method and wait the app till idles ---- + app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE) + app$wait_for_idle(timeout = 40000) + + ### Input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button and wait the app to idle ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Prevalence tab and wait the app to idle ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) + + ### Select source of data ---- + app$set_inputs( + `prevalence-source` = "screening", + wait_ = TRUE, + timeout_ = 40000 + ) + + ### Select the method ---- + app$set_inputs(`prevalence-has_age` = "yes", wait_ = TRUE, timeout_ = 40000) + app$set_inputs(`prevalence-area1` = "analysis_unit", wait_ = FALSE) + app$set_inputs(`prevalence-area2` = "sex", wait_ = FALSE) ## Assume sex as grouping var + app$set_inputs(`prevalence-area3` = "", wait_ = FALSE) + app$set_inputs(`prevalence-muac` = "muac", wait_ = FALSE) + app$set_inputs(`prevalence-age` = "age", wait_ = FALSE) + + ### Click on Estime Prevalence button ---- + app$click(input = "prevalence-estimate") + app$wait_for_value(output = "prevalence-results", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() {return $(this).text();}).get();" - js_values <- "$('#prevalence-results tbody tr').map(function() + js_values <- "$('#prevalence-results tbody tr').map(function() {return $(this).text();}).get();" - ### Capture results ---- - glued_results_unit_a <- app$get_js(js_values)[[1]] - glued_results_unit_b <- app$get_js(js_values)[[2]] + ### Capture results ---- + glued_results_unit_a <- app$get_js(js_values)[[1]] + glued_results_unit_b <- app$get_js(js_values)[[2]] - N_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d{3}$")[[1]] - N_unit_b <- stringr::str_extract_all(glued_results_unit_b, "\\d{4}$")[[1]] + N_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d{3}$")[[1]] + N_unit_b <- stringr::str_extract_all(glued_results_unit_b, "\\d{4}$")[[1]] - #### Prevalences ---- - prev_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d\\.\\d")[[1]] - prev_unit_b <- stringr::str_extract(glued_results_unit_b, "\\d{2}\\.\\d")[[1]] + #### Prevalences ---- + prev_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d\\.\\d")[[ + 1 + ]] + prev_unit_b <- stringr::str_extract(glued_results_unit_b, "\\d{2}\\.\\d")[[1]] + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:9]), 9) + testthat::expect_equal(as.numeric(N_unit_a), 608) + testthat::expect_equal(as.numeric(N_unit_b), 1359) + testthat::expect_equal(as.numeric(prev_unit_a)[1], 6.4) # GAM + testthat::expect_equal(as.numeric(prev_unit_a)[2], 1.2) # SAM + testthat::expect_equal(as.numeric(prev_unit_a)[3], 5.3) # MAM + testthat::expect_equal(as.numeric(prev_unit_b), 12.4) # Age-weighted GAM - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:9]), 9) - testthat::expect_equal(as.numeric(N_unit_a), 608) - testthat::expect_equal(as.numeric(N_unit_b), 1359) - testthat::expect_equal(as.numeric(prev_unit_a)[1], 6.4) # GAM - testthat::expect_equal(as.numeric(prev_unit_a)[2], 1.2) # SAM - testthat::expect_equal(as.numeric(prev_unit_a)[3], 5.3) # MAM - testthat::expect_equal(as.numeric(prev_unit_b), 12.4) # Age-weighted GAM - - ### Stop the app ---- - app$stop() - } -) + ### Stop the app ---- + app$stop() +}) ### When age is given in categories ---- -testthat::test_that( - desc = "Prevalence tab works as expected when age is given in categories", - code = { - #### Initialise app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - timeout = 120000, - wait = TRUE +testthat::test_that(desc = "Prevalence tab works as expected when age is given in categories", code = { + #### Initialise app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + timeout = 120000, + wait = TRUE + ) + + #### Wait app to idle ---- + app$wait_for_idle(timeout = 40000) + + #### Click on the Data Upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-02.csv"), + check.names = FALSE + ) + + ### Make age categories ---- + data <- data |> + transform( + age_cat = ifelse(age < 24, "6-23", "24-59"), + oedema = dplyr::recode_values(oedema, "n " ~ "n") ) - #### Wait app to idle ---- - app$wait_for_idle(timeout = 40000) + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) - #### Click on the Data Upload tab ---- - app$click(selector = "a[data-value='Data Upload']") + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - app$wait_for_idle(timeout = 40000) + ### Click on Data Wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling'") + app$wait_for_idle(timeout = 40000) - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-02.csv"), - check.names = FALSE - ) + #### Select data wrangling method ---- + app$set_inputs("wrangle_data-wrangle" = "muac") + app$wait_for_idle(timeout = 40000) - ### Make age categories ---- - data <- data |> - transform( - age_cat = ifelse(age < 24, "6-23", "24-59"), - oedema = dplyr::recode_values(oedema, "n " ~ "n") - ) - - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on Data Wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling'") - app$wait_for_idle(timeout = 40000) - - #### Select data wrangling method ---- - app$set_inputs("wrangle_data-wrangle" = "muac") - app$wait_for_idle(timeout = 40000) - - #### Select variables ---- - app$set_inputs("wrangle_data-sex" = "sex", wait_ = FALSE) - app$set_inputs("wrangle_data-muac" = "muac", wait_ = FALSE) - - #### Click on wrangle button ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - #### Click on Prevalence tab ---- - app$click(selector = "a[data-value='Prevalence Analysis']") - app$wait_for_idle(timeout = 40000) - - #### Select source of data ---- - app$set_inputs("prevalence-source" = "screening", wait_ = FALSE) - app$wait_for_idle(timeout = 40000) - - #### Select if age is available ---- - app$set_inputs("prevalence-has_age" = "no", wait_ = TRUE) - - #### Select variables ---- - app$set_inputs("prevalence-area1" = "analysis_unit", wait_ = FALSE) - app$set_inputs("prevalence-area2" = "sex", wait_ = FALSE) - app$set_inputs("prevalence-area3" = "", wait_ = FALSE) - app$set_inputs("prevalence-muac" = "muac", wait_ = FALSE) - app$set_inputs("prevalence-age_cat" = "age_cat", wait_ = FALSE) - app$set_inputs("prevalence-oedema" = "oedema", wait_ = FALSE) - - #### Click on Estimate Prevalence button ---- - app$click(input = "prevalence-estimate") - #### Wait until output has been rendered ---- - app$wait_for_value(output = "prevalence-results", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#prevalence-results thead th').map(function() - {return $(this).text();}).get();" + #### Select variables ---- + app$set_inputs("wrangle_data-sex" = "sex", wait_ = FALSE) + app$set_inputs("wrangle_data-muac" = "muac", wait_ = FALSE) - js_values <- "$('#prevalence-results tbody tr').map(function() - {return $(this).text();}).get();" + #### Click on wrangle button ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) - ### Capture prevalence ---- - glued_results_unit_a <- app$get_js(js_values)[[1]] - glued_results_unit_b <- app$get_js(js_values)[[2]] + #### Click on Prevalence tab ---- + app$click(selector = "a[data-value='Prevalence Analysis']") + app$wait_for_idle(timeout = 40000) - N_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d{3}$")[[1]] - N_unit_b <- stringr::str_extract_all(glued_results_unit_b, "\\d{4}$")[[1]] + #### Select source of data ---- + app$set_inputs("prevalence-source" = "screening", wait_ = FALSE) + app$wait_for_idle(timeout = 40000) - #### Prevalences ---- - prev_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d\\.\\d")[[1]] - prev_unit_b <- stringr::str_extract(glued_results_unit_b, "\\d{2}\\.\\d")[[1]] + #### Select if age is available ---- + app$set_inputs("prevalence-has_age" = "no", wait_ = TRUE) + #### Select variables ---- + app$set_inputs("prevalence-area1" = "analysis_unit", wait_ = FALSE) + app$set_inputs("prevalence-area2" = "sex", wait_ = FALSE) + app$set_inputs("prevalence-area3" = "", wait_ = FALSE) + app$set_inputs("prevalence-muac" = "muac", wait_ = FALSE) + app$set_inputs("prevalence-age_cat" = "age_cat", wait_ = FALSE) - ### Test check ---- - testthat::expect_equal(length(app$get_js(js_cols)[1:9]), 9) - testthat::expect_equal(as.numeric(N_unit_a), 612) - testthat::expect_equal(as.numeric(N_unit_b), 1365) - testthat::expect_equal(as.numeric(prev_unit_a)[1], 6.4) # GAM - testthat::expect_equal(as.numeric(prev_unit_a)[2], 1.1) # SAM - testthat::expect_equal(as.numeric(prev_unit_a)[3], 5.2) # MAM - testthat::expect_equal(as.numeric(prev_unit_b), 12.6) # Age-weighted GAM + #### Click on Estimate Prevalence button ---- + app$click(input = "prevalence-estimate") + #### Wait until output has been rendered ---- + app$wait_for_value(output = "prevalence-results", timeout = 40000) - ### Stop the app ---- - app$stop() - } -) + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#prevalence-results thead th').map(function() + {return $(this).text();}).get();" + + js_values <- "$('#prevalence-results tbody tr').map(function() + {return $(this).text();}).get();" + + ### Capture prevalence ---- + glued_results_unit_a <- app$get_js(js_values)[[1]] + glued_results_unit_b <- app$get_js(js_values)[[2]] + + N_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d{3}$")[[1]] + N_unit_b <- stringr::str_extract_all(glued_results_unit_b, "\\d{4}$")[[1]] + + #### Prevalences ---- + prev_unit_a <- stringr::str_extract_all(glued_results_unit_a, "\\d\\.\\d")[[ + 1 + ]] + prev_unit_b <- stringr::str_extract(glued_results_unit_b, "\\d{2}\\.\\d")[[1]] + + ### Test check ---- + testthat::expect_equal(length(app$get_js(js_cols)[1:9]), 9) + testthat::expect_equal(as.numeric(N_unit_a), 612) + testthat::expect_equal(as.numeric(N_unit_b), 1365) + testthat::expect_equal(as.numeric(prev_unit_a)[1], 6.4) # GAM + testthat::expect_equal(as.numeric(prev_unit_a)[2], 1.1) # SAM + testthat::expect_equal(as.numeric(prev_unit_a)[3], 5.2) # MAM + testthat::expect_equal(as.numeric(prev_unit_b), 12.6) # Age-weighted GAM + + ### Stop the app ---- + app$stop() +}) From 506381b13f971936841530cd23f886bfcebd400b Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 16:12:08 +0200 Subject: [PATCH 24/30] add testthat::skip_on_cran() to all AppDriver-based tests --- tests/testthat/test-module-data-upload.R | 44 +- tests/testthat/test-module-ipc-check.R | 370 ++++++----- .../testthat/test-module-plausibility-check.R | 600 +++++++++--------- tests/testthat/test-module-prevalence.R | 24 + tests/testthat/test-module-wrangling.R | 21 + 5 files changed, 571 insertions(+), 488 deletions(-) diff --git a/tests/testthat/test-module-data-upload.R b/tests/testthat/test-module-data-upload.R index 60b0ad1..3092892 100644 --- a/tests/testthat/test-module-data-upload.R +++ b/tests/testthat/test-module-data-upload.R @@ -2,16 +2,12 @@ # Test Suite: Module Data Upload # ============================================================================== - ## ---- Module: Data Upload ---------------------------------------------------- - -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - testthat::test_that("Data upload tab works as expected", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -46,23 +42,41 @@ testthat::test_that("Data upload tab works as expected", { ) ### Test checks ---- - testthat::expect_gte(object = column_names$input$`upload_data-upload`$size, 130756) - testthat::expect_equal(object = column_names$input$`upload_data-upload`$type, "text/csv") + testthat::expect_gte( + object = column_names$input$`upload_data-upload`$size, + 130756 + ) + testthat::expect_equal( + object = column_names$input$`upload_data-upload`$type, + "text/csv" + ) testthat::expect_true(object = column_names$output$`upload_data-fileUploaded`) - testthat::expect_true(app$get_js("$('#upload_data-uploadedDataTable').length > 0")) + testthat::expect_true(app$get_js( + "$('#upload_data-uploadedDataTable').length > 0" + )) expect_equal( - object = app$get_js(" + object = app$get_js( + " $('#upload_data-uploadedDataTable thead th').map(function() { return $(this).text(); }).get(); - ")[1:10] |> as.character(), + " + )[1:10] |> + as.character(), expected = c( - "province", "strata", "cluster", "sex", "age", "weight", "height", - "oedema", "muac", "wtfactor" + "province", + "strata", + "cluster", + "sex", + "age", + "weight", + "height", + "oedema", + "muac", + "wtfactor" ) ) #### Stop the app ---- app$stop() }) - diff --git a/tests/testthat/test-module-ipc-check.R b/tests/testthat/test-module-ipc-check.R index 372af80..7a4dfab 100644 --- a/tests/testthat/test-module-ipc-check.R +++ b/tests/testthat/test-module-ipc-check.R @@ -2,214 +2,206 @@ # Test Suite: Module IPC Check # ============================================================================== - ## ---- IPC check on survey data ----------------------------------------------- - -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - -testthat::test_that( - "IPC check's server module behaves as expected on survey data", - { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - load_timeout = 120000, - wait = TRUE - ) - - ### Let the app load ---- - app$wait_for_idle(timeout = 40000) - - ### Click on the Data uploading navbar ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - ### Upload data ---- - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the Data uploading navbar ---- - app$click(selector = "a[data-value='IPC Check']") - app$wait_for_idle(timeout = 40000) - - #### Set IPC Check for survey data ---- - app$set_inputs(`ipc_check-ipccheck` = "survey", wait_ = FALSE) - app$wait_for_idle(timeout = 40000) - - #### Now set parameters for survey ---- - app$set_inputs(`ipc_check-area1` = "province", wait_ = FALSE) - app$set_inputs(`ipc_check-area2` = "strata", wait_ = FALSE) - app$set_inputs(`ipc_check-psu` = "cluster", wait_ = FALSE) - - #### Run check ---- - app$click(input = "ipc_check-apply_check") - app$wait_for_value(output = "ipc_check-checked", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#ipc_check-checked thead th').map(function() { +testthat::test_that("IPC check's server module behaves as expected on survey data", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + load_timeout = 120000, + wait = TRUE + ) + + ### Let the app load ---- + app$wait_for_idle(timeout = 40000) + + ### Click on the Data uploading navbar ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + ### Upload data ---- + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the Data uploading navbar ---- + app$click(selector = "a[data-value='IPC Check']") + app$wait_for_idle(timeout = 40000) + + #### Set IPC Check for survey data ---- + app$set_inputs(`ipc_check-ipccheck` = "survey", wait_ = FALSE) + app$wait_for_idle(timeout = 40000) + + #### Now set parameters for survey ---- + app$set_inputs(`ipc_check-area1` = "province", wait_ = FALSE) + app$set_inputs(`ipc_check-area2` = "strata", wait_ = FALSE) + app$set_inputs(`ipc_check-psu` = "cluster", wait_ = FALSE) + + #### Run check ---- + app$click(input = "ipc_check-apply_check") + app$wait_for_value(output = "ipc_check-checked", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#ipc_check-checked thead th').map(function() { return $(this).text();}).get();" - js_values <- "$('#ipc_check-checked tbody tr').map(function() + js_values <- "$('#ipc_check-checked tbody tr').map(function() {return $(this).text();}).get();" - ### Test check ---- - testthat::expect_true(app$get_js("$('#ipc_check-checked').length > 0")) - testthat::expect_equal(as.character(app$get_js(js_cols)[1:5]), + ### Test check ---- + testthat::expect_true(app$get_js("$('#ipc_check-checked').length > 0")) + testthat::expect_equal( + as.character(app$get_js(js_cols)[1:5]), c("province", "strata", "n_clusters", "n_obs", "meet_ipc") - ) - testthat::expect_equal(app$get_js(js_values)[[1]], "NampulaRural60472yes") - testthat::expect_equal(app$get_js(js_values)[[3]], "ZambeziaRural51368yes") - } -) + ) + testthat::expect_equal(app$get_js(js_values)[[1]], "NampulaRural60472yes") + testthat::expect_equal(app$get_js(js_values)[[3]], "ZambeziaRural51368yes") +}) ## ---- IPC Check on screening data -------------------------------------------- - -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - -testthat::test_that( - "IPC check's server module behaves as expected on screening data", - { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - load_timeout = 120000, - wait = TRUE - ) - - ### Let the app load ---- - app$wait_for_idle(timeout = 40000) - - ### Click on the Data uploading navbar ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - ### Upload data ---- - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - #### Set IPC Check for screening data ---- - app$set_inputs(`ipc_check-ipccheck` = "screening", wait_ = TRUE, timeout_ = 10000) - app$wait_for_idle(timeout = 40000) - - ### Click on the Data uploading navbar ---- - app$click(selector = "a[data-value='IPC Check']") - app$wait_for_idle(timeout = 40000) - - #### Now set parameters for survey ---- - app$set_inputs(`ipc_check-area1` = "province", wait_ = FALSE) - app$set_inputs(`ipc_check-area2` = "strata", wait_ = FALSE) - app$set_inputs(`ipc_check-sites` = "cluster", wait_ = FALSE) - - #### Run check ---- - app$click(input = "ipc_check-apply_check") - app$wait_for_value(output = "ipc_check-checked", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#ipc_check-checked thead th').map(function() { +testthat::test_that("IPC check's server module behaves as expected on screening data", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + load_timeout = 120000, + wait = TRUE + ) + + ### Let the app load ---- + app$wait_for_idle(timeout = 40000) + + ### Click on the Data uploading navbar ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + ### Upload data ---- + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + #### Set IPC Check for screening data ---- + app$set_inputs( + `ipc_check-ipccheck` = "screening", + wait_ = TRUE, + timeout_ = 10000 + ) + app$wait_for_idle(timeout = 40000) + + ### Click on the Data uploading navbar ---- + app$click(selector = "a[data-value='IPC Check']") + app$wait_for_idle(timeout = 40000) + + #### Now set parameters for survey ---- + app$set_inputs(`ipc_check-area1` = "province", wait_ = FALSE) + app$set_inputs(`ipc_check-area2` = "strata", wait_ = FALSE) + app$set_inputs(`ipc_check-sites` = "cluster", wait_ = FALSE) + + #### Run check ---- + app$click(input = "ipc_check-apply_check") + app$wait_for_value(output = "ipc_check-checked", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#ipc_check-checked thead th').map(function() { return $(this).text();}).get();" - js_values <- "$('#ipc_check-checked tbody tr').map(function() + js_values <- "$('#ipc_check-checked tbody tr').map(function() {return $(this).text();}).get();" - ### Test ---- - testthat::expect_true(app$get_js("$('#ipc_check-checked').length > 0")) - testthat::expect_equal(as.character(app$get_js(js_cols)[1:5]), + ### Test ---- + testthat::expect_true(app$get_js("$('#ipc_check-checked').length > 0")) + testthat::expect_equal( + as.character(app$get_js(js_cols)[1:5]), c("province", "strata", "n_clusters", "n_obs", "meet_ipc") - ) - testthat::expect_equal(app$get_js(js_values)[[1]], "NampulaRural60472no") - testthat::expect_equal(app$get_js(js_values)[[3]], "ZambeziaRural51368no") - } -) + ) + testthat::expect_equal(app$get_js(js_values)[[1]], "NampulaRural60472no") + testthat::expect_equal(app$get_js(js_values)[[3]], "ZambeziaRural51368no") +}) ## ---- IPC Check on sentinel site data ---------------------------------------- - -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - -testthat::test_that( - "IPC check's server module behaves as expected on sentinel site data", - { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - load_timeout = 120000, - wait = TRUE - ) - - ### Let the app load ---- - app$wait_for_idle(timeout = 40000) - - ### Click on the Data uploading navbar ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - ### Upload data ---- - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the IPC Check nav bar ---- - app$click(selector = "a[data-value='IPC Check']") - - #### Set IPC Check for screening data ---- - app$set_inputs(`ipc_check-ipccheck` = "sentinel", wait_ = TRUE, timeout_ = 10000) - app$wait_for_idle(timeout = 40000) - - #### Now set parameters for survey ---- - app$set_inputs(`ipc_check-area1` = "province", wait_ = FALSE) - app$set_inputs(`ipc_check-area2` = "strata", wait_ = FALSE) - app$set_inputs(`ipc_check-ssites` = "cluster", wait_ = FALSE) - - #### Run check ---- - app$click(input = "ipc_check-apply_check") - app$wait_for_value(output = "ipc_check-checked", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#ipc_check-checked thead th').map(function() { +testthat::test_that("IPC check's server module behaves as expected on sentinel site data", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + load_timeout = 120000, + wait = TRUE + ) + + ### Let the app load ---- + app$wait_for_idle(timeout = 40000) + + ### Click on the Data uploading navbar ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + ### Upload data ---- + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the IPC Check nav bar ---- + app$click(selector = "a[data-value='IPC Check']") + + #### Set IPC Check for screening data ---- + app$set_inputs( + `ipc_check-ipccheck` = "sentinel", + wait_ = TRUE, + timeout_ = 10000 + ) + app$wait_for_idle(timeout = 40000) + + #### Now set parameters for survey ---- + app$set_inputs(`ipc_check-area1` = "province", wait_ = FALSE) + app$set_inputs(`ipc_check-area2` = "strata", wait_ = FALSE) + app$set_inputs(`ipc_check-ssites` = "cluster", wait_ = FALSE) + + #### Run check ---- + app$click(input = "ipc_check-apply_check") + app$wait_for_value(output = "ipc_check-checked", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#ipc_check-checked thead th').map(function() { return $(this).text();}).get();" - js_values <- "$('#ipc_check-checked tbody tr').map(function() + js_values <- "$('#ipc_check-checked tbody tr').map(function() {return $(this).text();}).get();" - ### Test ---- - testthat::expect_true(app$get_js("$('#ipc_check-checked').length > 0")) - testthat::expect_equal(as.character(app$get_js(js_cols)[1:5]), + ### Test ---- + testthat::expect_true(app$get_js("$('#ipc_check-checked').length > 0")) + testthat::expect_equal( + as.character(app$get_js(js_cols)[1:5]), c("province", "strata", "n_clusters", "n_obs", "meet_ipc") - ) - testthat::expect_equal(app$get_js(js_values)[[1]], "NampulaRural60472yes") - testthat::expect_equal(app$get_js(js_values)[[3]], "ZambeziaRural51368yes") - } -) + ) + testthat::expect_equal(app$get_js(js_values)[[1]], "NampulaRural60472yes") + testthat::expect_equal(app$get_js(js_values)[[3]], "ZambeziaRural51368yes") +}) diff --git a/tests/testthat/test-module-plausibility-check.R b/tests/testthat/test-module-plausibility-check.R index 76fdd16..1c05d09 100644 --- a/tests/testthat/test-module-plausibility-check.R +++ b/tests/testthat/test-module-plausibility-check.R @@ -2,309 +2,341 @@ # Test Suite: Module Plausibility Check # ============================================================================== - ## ---- Plausibility Check on WFHZ data ---------------------------------------- - -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - -testthat::test_that( - desc = "Plausibility check module works well for WFHZ data", - code = { - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - load_timeout = 120000, - wait = TRUE - ) - - ### Let the app load ---- - app$wait_for_idle(timeout = 40000) - - ### Click on data upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Find the data to upload ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method ---- - app$set_inputs(`wrangle_data-wrangle` = "wfhz", wait_ = FALSE) - - ### Select input variables ---- - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) - app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) - - ### Click wrangle button ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Plausibility Check tab ---- - app$click(selector = "a[data-value='Plausibility Check']") - app$wait_for_idle(timeout = 40000) - - ### Select method for plausibility check ---- - app$set_inputs(`plausible-method` = "wfhz", wait_ = FALSE) - - ### Select input variables ---- - app$set_inputs(`plausible-area1` = "province", wait_ = FALSE) - app$set_inputs(`plausible-area2` = "strata", wait_ = FALSE) - app$set_inputs(`plausible-area3` = "sex", wait_ = FALSE) - app$set_inputs(`plausible-sex` = "sex", wait_ = FALSE) - app$set_inputs(`plausible-age` = "age", wait_ = FALSE) - app$set_inputs(`plausible-weight` = "weight", wait_ = FALSE) - app$set_inputs(`plausible-height` = "height", wait_ = FALSE) - app$set_inputs(`plausible-flags` = "flag_wfhz", wait_ = FALSE) - - ### Click on check plausibility button ---- - app$click(input = "plausible-check") - app$wait_for_value(output = "plausible-checked", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#plausible-checked thead th').map(function() { +testthat::test_that(desc = "Plausibility check module works well for WFHZ data", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + load_timeout = 120000, + wait = TRUE + ) + + ### Let the app load ---- + app$wait_for_idle(timeout = 40000) + + ### Click on data upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Find the data to upload ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method ---- + app$set_inputs(`wrangle_data-wrangle` = "wfhz", wait_ = FALSE) + + ### Select input variables ---- + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-weight` = "weight", wait_ = FALSE) + app$set_inputs(`wrangle_data-height` = "height", wait_ = FALSE) + + ### Click wrangle button ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Plausibility Check tab ---- + app$click(selector = "a[data-value='Plausibility Check']") + app$wait_for_idle(timeout = 40000) + + ### Select method for plausibility check ---- + app$set_inputs(`plausible-method` = "wfhz", wait_ = FALSE) + + ### Select input variables ---- + app$set_inputs(`plausible-area1` = "province", wait_ = FALSE) + app$set_inputs(`plausible-area2` = "strata", wait_ = FALSE) + app$set_inputs(`plausible-area3` = "sex", wait_ = FALSE) + app$set_inputs(`plausible-sex` = "sex", wait_ = FALSE) + app$set_inputs(`plausible-age` = "age", wait_ = FALSE) + app$set_inputs(`plausible-weight` = "weight", wait_ = FALSE) + app$set_inputs(`plausible-height` = "height", wait_ = FALSE) + app$set_inputs(`plausible-flags` = "flag_wfhz", wait_ = FALSE) + + ### Click on check plausibility button ---- + app$click(input = "plausible-check") + app$wait_for_value(output = "plausible-checked", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#plausible-checked thead th').map(function() { return $(this).text();}).get();" - - js_values <- "$('#plausible-checked tbody tr').map(function() + + js_values <- "$('#plausible-checked tbody tr').map(function() {return $(this).text();}).get();" - ### Capture Zambezia-urban plausibility check results ---- - plausibility_results <- - "ZambeziaRural23681.4%Excellent<0.001Problematic0.882Excellent9Good7Excellent0.92Excellent0.1Excellent0.2Excellent12Good" - - ### Test check ----- - testthat::expect_equal(as.character(app$get_js(js_cols)[1:22]), - expected = c( - "Province", "Strata", "Sex", "Total children", "Flagged data (%)", - "Class. of flagged data", "Sex ratio (p)", "Class. of sex ratio", - "Age ratio (p)", "Class. of age ratio", "DPS weight (#)", "Class. DPS weight", - "DPS height (#)", "Class. DPS height", "Standard Dev* (#)", - "Class. of standard dev", "Skewness* (#)", "Class. of skewness", - "Kurtosis* (#)", "Class. of kurtosis", "Overall score", "Overall quality" - ) + ### Capture Zambezia-urban plausibility check results ---- + plausibility_results <- + "ZambeziaRural23681.4%Excellent<0.001Problematic0.882Excellent9Good7Excellent0.92Excellent0.1Excellent0.2Excellent12Good" + + ### Test check ----- + testthat::expect_equal( + as.character(app$get_js(js_cols)[1:22]), + expected = c( + "Province", + "Strata", + "Sex", + "Total children", + "Flagged data (%)", + "Class. of flagged data", + "Sex ratio (p)", + "Class. of sex ratio", + "Age ratio (p)", + "Class. of age ratio", + "DPS weight (#)", + "Class. DPS weight", + "DPS height (#)", + "Class. DPS height", + "Standard Dev* (#)", + "Class. of standard dev", + "Skewness* (#)", + "Class. of skewness", + "Kurtosis* (#)", + "Class. of kurtosis", + "Overall score", + "Overall quality" ) - testthat::expect_equal(app$get_js(js_values)[[3]], plausibility_results) - ### Stop the app ---- - app$stop() - } -) + ) + testthat::expect_equal(app$get_js(js_values)[[3]], plausibility_results) + ### Stop the app ---- + app$stop() +}) ## ---- Plausibility Check on MFAZ data ---------------------------------------- - -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - -testthat::test_that( - desc = "Plausibility check module works well for MFAZ data", - code = { - # Initialise app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - load_timeout = 120000, - wait = TRUE - ) - - ### Let the app load ---- - app$wait_for_idle(timeout = 40000) - - ### Click on the Data uploading navbar ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Read data ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE - ) - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload onto the app ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method ---- - app$set_inputs(`wrangle_data-wrangle` = "mfaz", wait_ = TRUE, timeout_ = 15000) - app$wait_for_idle(timeout = 40000) - - app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) - app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Plausibility Check tab ---- - app$click(selector = "a[data-value='Plausibility Check']") - app$wait_for_idle(timeout = 40000) - - ### Select method for plausibility check ---- - app$set_inputs(`plausible-method` = "mfaz", wait_ = TRUE, timeout_ = 15000) - - ### Select input variables ---- - app$set_inputs(`plausible-area1` = "province", wait_ = FALSE) - app$set_inputs(`plausible-area2` = "strata", wait_ = FALSE) - app$set_inputs(`plausible-area3` = "sex", wait_ = FALSE) - app$set_inputs(`plausible-sex` = "sex", wait_ = FALSE) - app$set_inputs(`plausible-age` = "age", wait_ = FALSE) - app$set_inputs(`plausible-muac` = "muac", wait_ = FALSE) - app$set_inputs(`plausible-flags` = "flag_mfaz", wait_ = FALSE) - - ### Click on check plausibility button ---- - app$click(input = "plausible-check") - app$wait_for_value(output = "plausible-checked", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#plausible-checked thead th').map(function() { +testthat::test_that(desc = "Plausibility check module works well for MFAZ data", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + + # Initialise app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + load_timeout = 120000, + wait = TRUE + ) + + ### Let the app load ---- + app$wait_for_idle(timeout = 40000) + + ### Click on the Data uploading navbar ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Read data ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload onto the app ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method ---- + app$set_inputs( + `wrangle_data-wrangle` = "mfaz", + wait_ = TRUE, + timeout_ = 15000 + ) + app$wait_for_idle(timeout = 40000) + + app$set_inputs(`wrangle_data-dos` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-dob` = "", wait_ = FALSE) + app$set_inputs(`wrangle_data-age` = "age", wait_ = FALSE) + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Plausibility Check tab ---- + app$click(selector = "a[data-value='Plausibility Check']") + app$wait_for_idle(timeout = 40000) + + ### Select method for plausibility check ---- + app$set_inputs(`plausible-method` = "mfaz", wait_ = TRUE, timeout_ = 15000) + + ### Select input variables ---- + app$set_inputs(`plausible-area1` = "province", wait_ = FALSE) + app$set_inputs(`plausible-area2` = "strata", wait_ = FALSE) + app$set_inputs(`plausible-area3` = "sex", wait_ = FALSE) + app$set_inputs(`plausible-sex` = "sex", wait_ = FALSE) + app$set_inputs(`plausible-age` = "age", wait_ = FALSE) + app$set_inputs(`plausible-muac` = "muac", wait_ = FALSE) + app$set_inputs(`plausible-flags` = "flag_mfaz", wait_ = FALSE) + + ### Click on check plausibility button ---- + app$click(input = "plausible-check") + app$wait_for_value(output = "plausible-checked", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#plausible-checked thead th').map(function() { return $(this).text();}).get();" - js_values <- "$('#plausible-checked tbody tr').map(function() + js_values <- "$('#plausible-checked tbody tr').map(function() {return $(this).text();}).get();" - ### Capture Nampula-urban plausibility check results ---- - plausibility_results <- - "NampulaUrban26141.3%Good<0.001Problematic0.241Excellent10Good0.96Excellent-0.36Excellent0.27Good18Acceptable" - - ### Test check ---- - testthat::expect_equal(as.character(app$get_js(js_cols)[1:20]), - expected = c( - "Province", "Strata", "Sex", "Total children", "Flagged data (%)", - "Class. of flagged data", "Sex ratio (p)", "Class. of sex ratio", - "Age ratio (p)", "Class. of age ratio", "DPS (#)", - "Class. of DPS", "Standard Dev* (#)", "Class. of standard dev", - "Skewness* (#)", "Class. of skewness", "Kurtosis* (#)", - "Class. of kurtosis", "Overall score", "Overall quality" - ) + ### Capture Nampula-urban plausibility check results ---- + plausibility_results <- + "NampulaUrban26141.3%Good<0.001Problematic0.241Excellent10Good0.96Excellent-0.36Excellent0.27Good18Acceptable" + + ### Test check ---- + testthat::expect_equal( + as.character(app$get_js(js_cols)[1:20]), + expected = c( + "Province", + "Strata", + "Sex", + "Total children", + "Flagged data (%)", + "Class. of flagged data", + "Sex ratio (p)", + "Class. of sex ratio", + "Age ratio (p)", + "Class. of age ratio", + "DPS (#)", + "Class. of DPS", + "Standard Dev* (#)", + "Class. of standard dev", + "Skewness* (#)", + "Class. of skewness", + "Kurtosis* (#)", + "Class. of kurtosis", + "Overall score", + "Overall quality" ) - testthat::expect_equal(app$get_js(js_values)[[2]], plausibility_results) - ### Stop the app ---- - app$stop() - } -) + ) + testthat::expect_equal(app$get_js(js_values)[[2]], plausibility_results) + ### Stop the app ---- + app$stop() +}) ## ---- Plausibility Check on raw MUAC data ------------------------------------ +testthat::test_that(desc = "Plausibility check module works well for MUAC data", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + + ### Initialise mwana app ---- + app <- shinytest2::AppDriver$new( + app_dir = testthat::test_path("fixtures"), + load_timeout = 120000, + wait = TRUE + ) + + ### Let the app load ---- + app$wait_for_idle(timeout = 40000) + + ### Click on data upload tab ---- + app$click(selector = "a[data-value='Data Upload']") + app$wait_for_idle(timeout = 40000) + + #### Find the data to upload ---- + data <- read.csv( + file = testthat::test_path("fixtures", "anthro-01.csv"), + check.names = FALSE + ) + + tempfile <- tempfile(fileext = ".csv") + write.csv(data, tempfile, row.names = FALSE) + + #### Upload ---- + app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) + + ### Click on the data wrangling tab ---- + app$click(selector = "a[data-value='Data Wrangling']") + app$wait_for_idle(timeout = 40000) + + ### Select data wrangling method ---- + app$set_inputs( + `wrangle_data-wrangle` = "muac", + wait_ = TRUE, + timeout_ = 15000 + ) + app$wait_for_idle(timeout = 40000) + + ### Select input variables ---- + app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) + app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) + + ### Click wrangle button ---- + app$click(input = "wrangle_data-apply_wrangle") + app$wait_for_idle(timeout = 40000) + + ### Click on the Plausibility Check tab ---- + app$click(selector = "a[data-value='Plausibility Check']") + app$wait_for_idle(timeout = 40000) + + ### Select method for plausibility check ---- + app$set_inputs(`plausible-method` = "muac", wait_ = TRUE, timeout_ = 15000) + app$wait_for_idle(timeout = 40000) + + ### Select input variables ---- + app$set_inputs(`plausible-area1` = "province", wait_ = FALSE) + app$set_inputs(`plausible-area2` = "strata", wait_ = FALSE) + app$set_inputs(`plausible-area3` = "sex", wait_ = FALSE) + app$set_inputs(`plausible-sex` = "sex", wait_ = FALSE) + app$set_inputs(`plausible-muac` = "muac", wait_ = FALSE) + app$set_inputs(`plausible-flags` = "flag_muac", wait_ = FALSE) + + ### Click on check plausibility button + app$click(input = "plausible-check") + app$wait_for_value(output = "plausible-checked", timeout = 40000) + + ### Capture JavaScript expressions to return results's cols and values ---- + js_cols <- "$('#plausible-checked thead th').map(function() { + return $(this).text();}).get();" + js_values <- "$('#plausible-checked tbody tr').map(function() + {return $(this).text();}).get();" -### Skip test on windows ---- -# if (identical(Sys.getenv("CI"), "true") && Sys.info()[["sysname"]] == "Windows") { -# skip("Skipping shinytest2 integration tests on Windows CI to reduce runtime") -# } - -testthat::test_that( - desc = "Plausibility check module works well for MUAC data", - code = { - - ### Initialise mwana app ---- - app <- shinytest2::AppDriver$new( - app_dir = testthat::test_path("fixtures"), - load_timeout = 120000, - wait = TRUE - ) - - ### Let the app load ---- - app$wait_for_idle(timeout = 40000) - - ### Click on data upload tab ---- - app$click(selector = "a[data-value='Data Upload']") - app$wait_for_idle(timeout = 40000) - - #### Find the data to upload ---- - data <- read.csv( - file = testthat::test_path("fixtures", "anthro-01.csv"), - check.names = FALSE + ### Capture Zambezia-urban plausibility check results ---- + plausibility_results <- + "ZambeziaUrban28130.1%Excellent<0.001Problematic5Excellent13.48Acceptable" + + ### Test check ----- + testthat::expect_equal( + as.character(app$get_js(js_cols)[1:12]), + expected = c( + "Province", + "Strata", + "Sex", + "Total children", + "Flagged data (%)", + "Class. of flagged data", + "Sex ratio (p)", + "Class. of sex ratio", + "DPS(#)", + "Class. of DPS", + "Standard Dev* (#)", + "Class. of standard dev" ) + ) - tempfile <- tempfile(fileext = ".csv") - write.csv(data, tempfile, row.names = FALSE) - - #### Upload ---- - app$upload_file(`upload_data-upload` = tempfile, wait_ = TRUE) - - ### Click on the data wrangling tab ---- - app$click(selector = "a[data-value='Data Wrangling']") - app$wait_for_idle(timeout = 40000) - - ### Select data wrangling method ---- - app$set_inputs(`wrangle_data-wrangle` = "muac", wait_ = TRUE, timeout_ = 15000) - app$wait_for_idle(timeout = 40000) - - ### Select input variables ---- - app$set_inputs(`wrangle_data-sex` = "sex", wait_ = FALSE) - app$set_inputs(`wrangle_data-muac` = "muac", wait_ = FALSE) - - ### Click wrangle button ---- - app$click(input = "wrangle_data-apply_wrangle") - app$wait_for_idle(timeout = 40000) - - ### Click on the Plausibility Check tab ---- - app$click(selector = "a[data-value='Plausibility Check']") - app$wait_for_idle(timeout = 40000) - - ### Select method for plausibility check ---- - app$set_inputs(`plausible-method` = "muac", wait_ = TRUE, timeout_ = 15000) - app$wait_for_idle(timeout = 40000) - - ### Select input variables ---- - app$set_inputs(`plausible-area1` = "province", wait_ = FALSE) - app$set_inputs(`plausible-area2` = "strata", wait_ = FALSE) - app$set_inputs(`plausible-area3` = "sex", wait_ = FALSE) - app$set_inputs(`plausible-sex` = "sex", wait_ = FALSE) - app$set_inputs(`plausible-muac` = "muac", wait_ = FALSE) - app$set_inputs(`plausible-flags` = "flag_muac", wait_ = FALSE) - - ### Click on check plausibility button - app$click(input = "plausible-check") - app$wait_for_value(output = "plausible-checked", timeout = 40000) - - ### Capture JavaScript expressions to return results's cols and values ---- - js_cols <- "$('#plausible-checked thead th').map(function() { - return $(this).text();}).get();" - js_values <- "$('#plausible-checked tbody tr').map(function() - {return $(this).text();}).get();" + testthat::expect_equal(app$get_js(js_values)[[4]], plausibility_results) - ### Capture Zambezia-urban plausibility check results ---- - plausibility_results <- - "ZambeziaUrban28130.1%Excellent<0.001Problematic5Excellent13.48Acceptable" - - ### Test check ----- - testthat::expect_equal(as.character(app$get_js(js_cols)[1:12]), - expected = c( - "Province", "Strata", "Sex", "Total children", "Flagged data (%)", - "Class. of flagged data", "Sex ratio (p)", "Class. of sex ratio", "DPS(#)", - "Class. of DPS", "Standard Dev* (#)", "Class. of standard dev")) - - testthat::expect_equal(app$get_js(js_values)[[4]], plausibility_results) - - ### Stop the app ---- - app$stop() - } -) + ### Stop the app ---- + app$stop() +}) diff --git a/tests/testthat/test-module-prevalence.R b/tests/testthat/test-module-prevalence.R index 5292d73..b15e165 100644 --- a/tests/testthat/test-module-prevalence.R +++ b/tests/testthat/test-module-prevalence.R @@ -6,6 +6,9 @@ ### WFHZ weighted prevalence ---- testthat::test_that(desc = "Module works well to estimate weighted-WFHZ prevalence from survey", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -95,6 +98,9 @@ testthat::test_that(desc = "Module works well to estimate weighted-WFHZ prevalen ### WFHZ unweighted prevalence ---- testthat::test_that(desc = "Module works well to estimate unweighted-WFHZ prevalence from survey", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -180,6 +186,9 @@ testthat::test_that(desc = "Module works well to estimate unweighted-WFHZ preval ### MUAC weighted prevalence ---- testthat::test_that(desc = "Module works well to estimate weighted-MUAC prevalence from survey", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -282,6 +291,9 @@ testthat::test_that(desc = "Module works well to estimate weighted-MUAC prevalen ### MUAC unweighted prevalence ---- testthat::test_that(desc = "Module works well to estimate unweighted-MUAC prevalence from survey", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -380,6 +392,9 @@ testthat::test_that(desc = "Module works well to estimate unweighted-MUAC preval ### Combined weighted prevalence ---- testthat::test_that(desc = "Module works well to estimate weighted-combined prevalence from survey", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -474,6 +489,9 @@ testthat::test_that(desc = "Module works well to estimate weighted-combined prev ### Combined unweighted prevalence ---- testthat::test_that(desc = "Module works well to estimate unweighted-combined prevalence from survey", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -565,6 +583,9 @@ testthat::test_that(desc = "Module works well to estimate unweighted-combined pr ### When age is available ---- testthat::test_that(desc = "Module works well to estimate prevalence from screening", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ### Initialise mwana app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -671,6 +692,9 @@ testthat::test_that(desc = "Module works well to estimate prevalence from screen ### When age is given in categories ---- testthat::test_that(desc = "Prevalence tab works as expected when age is given in categories", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + #### Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), diff --git a/tests/testthat/test-module-wrangling.R b/tests/testthat/test-module-wrangling.R index ab3afe2..f4ecf42 100644 --- a/tests/testthat/test-module-wrangling.R +++ b/tests/testthat/test-module-wrangling.R @@ -7,6 +7,9 @@ testthat::test_that(desc = "Server data wrangling works as expected for WFHZ", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ## Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -68,6 +71,9 @@ testthat::test_that(desc = "Server data wrangling works as expected for WFHZ", { ### When user supplies dos and dob for age wrangling ---- testthat::test_that(desc = "Server data wrangling wrangles age correctly in WFHZ", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ## Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -142,6 +148,9 @@ testthat::test_that(desc = "Server data wrangling wrangles age correctly in WFHZ testthat::test_that(desc = "Server data wrangling works as expected for MFAZ", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ## Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -204,6 +213,9 @@ testthat::test_that(desc = "Server data wrangling works as expected for MFAZ", { ### When user supplies dos and dob for age wrangling ---- testthat::test_that(desc = "Server data wrangling wrangles age correctly in MFAZ", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ## Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -279,6 +291,9 @@ testthat::test_that(desc = "Server data wrangling wrangles age correctly in MFAZ testthat::test_that( desc = "Server data wrangling works as expected for raw MUAC values", code = { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + #### Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -345,6 +360,9 @@ testthat::test_that( testthat::test_that( desc = "Server data wrangling works as expected for combined wrangling", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ## Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), @@ -402,6 +420,9 @@ testthat::test_that( ### When user supplies dos and dob for age wrangling ---- testthat::test_that(desc = "Server data wrangling wrangles age correctly in combined data wrangling", { + ### Skip test on CRAN ---- + testthat::skip_on_cran() + ## Initialise app ---- app <- shinytest2::AppDriver$new( app_dir = testthat::test_path("fixtures"), From bd765a7111b0af6f1c7e2ba07b4b617ebc1f3c6e Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 16:13:05 +0200 Subject: [PATCH 25/30] revise Title; remove word 'seamless' --- DESCRIPTION | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bc316f2..4cfe995 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,11 +8,10 @@ Authors@R: email = "tomas.zaba@outlook.com", comment = c(ORCID = "0000-0002-7079-3574") ) -Description: A seamless graphical interface to the 'mwana' R package for data +Description: A graphical interface to the 'mwana' R package for data wrangling, plausibility checks, and prevalence estimation of wasting. License: GPL (>= 3) Encoding: UTF-8 -LazyData: true Language: en-GB Roxygen: list(markdown = TRUE) URL: https://github.com/mphimo/mwanaApp From c4231a8bd280a2a5c417a8fb39a85f9cdbe74f6d Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 16:13:18 +0200 Subject: [PATCH 26/30] revise Title; remove word 'seamless' --- man/mwanaApp-package.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/mwanaApp-package.Rd b/man/mwanaApp-package.Rd index a9718ab..9461e24 100644 --- a/man/mwanaApp-package.Rd +++ b/man/mwanaApp-package.Rd @@ -4,9 +4,9 @@ \name{mwanaApp-package} \alias{mwanaApp} \alias{mwanaApp-package} -\title{mwanaApp: mwana GUI} +\title{mwanaApp: Graphical User Interface to 'mwana'} \description{ -A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation of wasting. +A graphical interface to the 'mwana' R package for data wrangling, plausibility checks, and prevalence estimation of wasting. } \seealso{ Useful links: From 59d1d3611b42e21102825ca7f8fce21f0a0b15be Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 17:21:24 +0200 Subject: [PATCH 27/30] add sample data with dos and dob --- tests/testthat/fixtures/anthro-03.csv | 45 +++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 tests/testthat/fixtures/anthro-03.csv diff --git a/tests/testthat/fixtures/anthro-03.csv b/tests/testthat/fixtures/anthro-03.csv new file mode 100644 index 0000000..2b2ce17 --- /dev/null +++ b/tests/testthat/fixtures/anthro-03.csv @@ -0,0 +1,45 @@ +survey_area,survdate,cluster,team,id,hh,sex,birthdat,age,months,weight,height,oedema +District A,03/04/2026,2,2,,2,m,04/07/2023,,32.99,16.4,94.3,n +District A,03/04/2026,2,2,,2,f,01/05/2025,,11.07,9.7,76.2,n +District A,03/04/2026,2,2,,6,m,03/08/2023,,32,13.3,95.6,n +District A,03/04/2026,2,2,,5,m,22/08/2025,,7.36,8.2,65,n +District A,03/04/2026,2,2,,10,f,02/04/2023,,36.04,13.1,97.4,n +District A,03/04/2026,2,2,,10,f,20/05/2024,,22.44,9.4,81.5,n +District A,03/04/2026,2,2,,14,f,10/04/2025,,11.76,8.4,75.7,n +District A,03/04/2026,3,3,,5,m,23/11/2023,,28.32,11.1,85,n +District A,03/04/2026,3,3,,5,m,17/03/2025,,12.55,7.7,69.7,n +District A,03/04/2026,4,4,,2,f,02/08/2022,,44.02,11.7,97.1,n +District A,03/04/2026,4,4,,2,f,10/06/2024,,21.75,9.2,80,n +District A,03/04/2026,4,4,,4,m,20/09/2025,,6.41,5.6,64.4,n +District A,03/04/2026,4,4,,8,f,09/06/2024,,21.78,9.1,76.6,n +District A,04/04/2026,6,2,,9,f,21/09/2025,,6.41,6.5,65.7,n +District A,04/04/2026,4,4,,2,f,09/02/2025,,13.77,6.4,63,n +District A,05/04/2026,9,1,,1,m,02/09/2025,,7.06,7.2,67,n +District A,05/04/2026,9,1,,2,m,06/05/2025,,10.97,6.9,67,n +District A,05/04/2026,12,4,,2,m,05/05/2025,,11.01,7.4,72.5,n +District A,05/04/2026,12,4,,14,f,11/08/2025,,7.79,5.8,65,n +District A,05/04/2026,12,4,,16,m,09/03/2025,,12.88,5.5,65,n +District A,05/04/2026,12,4,,19,m,07/03/2025,,12.94,5.9,65.3,n +District A,06/04/2026,14,2,,5,f,10/09/2025,,6.83,6.5,64,n +District A,06/04/2026,14,2,,14,f,22/03/2025,,12.48,5,65.2,n +District A,06/04/2026,16,4,,2,m,07/02/2025,,13.9,10.1,73.5,n +District A,06/04/2026,16,4,,6,f,10/04/2025,,11.86,9.1,78.5,n +District A,06/04/2026,16,4,,10,f,03/12/2022,,40.08,13.8,90,n +District A,06/04/2026,16,4,,10,f,03/05/2025,,11.1,7.3,77.2,n +District A,06/04/2026,16,4,,14,m,06/08/2025,,7.98,8,70,n +District A,07/04/2026,20,4,,2,f,10/07/2025,,8.9,6.1,65.7,n +District A,07/04/2026,20,4,,6,f,05/02/2025,,14,6.9,65.9,n +District A,07/04/2026,20,4,,14,f,10/07/2025,,8.9,5.6,65.5,n +District A,08/04/2026,24,4,,2,f,12/07/2025,,8.87,7.3,70.4,n +District A,08/04/2026,24,4,,8,f,10/09/2025,,6.9,7.5,68.4,n +District A,08/04/2026,24,4,,10,m,04/08/2025,,8.11,6.7,66.6,n +District A,08/04/2026,24,4,,12,m,06/07/2025,,9.07,5.6,65.1,n +District A,09/04/2026,28,4,,4,f,07/04/2025,,12.06,7.8,74.5,n +District A,09/04/2026,28,4,,9,f,12/07/2025,,8.9,5.3,66.3,n +District A,09/04/2026,28,4,,16,m,10/06/2025,,9.95,6.5,69,n +District A,09/04/2026,28,4,,17,m,13/09/2025,,6.83,4.9,60.1,n +District A,10/04/2026,29,1,,5,f,04/08/2025,,8.18,6.3,64.4,n +District A,10/04/2026,32,4,,2,m,04/04/2025,,12.19,7.3,70.5,n +District A,10/04/2026,32,4,,8,f,08/04/2025,,12.06,5.3,66.5,n +District A,10/04/2026,32,4,,14,m,11/06/2025,,9.95,6.7,69.5,n +District A,11/04/2026,33,1,,17,f,27/08/2025,,7.46,6,63.6,n \ No newline at end of file From bb064c1f54edf8d3a0b94766448bb4c9739593b0 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 18:15:55 +0200 Subject: [PATCH 28/30] test donwload-result button --- tests/testthat/test-module-prevalence.R | 96 +++++++++++++++++++++++++ 1 file changed, 96 insertions(+) diff --git a/tests/testthat/test-module-prevalence.R b/tests/testthat/test-module-prevalence.R index b15e165..6133d3c 100644 --- a/tests/testthat/test-module-prevalence.R +++ b/tests/testthat/test-module-prevalence.R @@ -69,6 +69,9 @@ testthat::test_that(desc = "Module works well to estimate weighted-WFHZ prevalen ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -90,6 +93,15 @@ testthat::test_that(desc = "Module works well to estimate weighted-WFHZ prevalen testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) testthat::expect_equal(as.numeric(weighted_pop), 292611) testthat::expect_equal(as.numeric(gam_prev), 6.1) + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-survey-wfhz_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -161,6 +173,9 @@ testthat::test_that(desc = "Module works well to estimate unweighted-WFHZ preval ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -178,6 +193,15 @@ testthat::test_that(desc = "Module works well to estimate unweighted-WFHZ preval testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) testthat::expect_equal(as.numeric(pop), 280) testthat::expect_equal(as.numeric(gam_prev), 6.1) + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-survey-wfhz_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -254,6 +278,9 @@ testthat::test_that(desc = "Module works well to estimate weighted-MUAC prevalen ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -283,6 +310,15 @@ testthat::test_that(desc = "Module works well to estimate weighted-MUAC prevalen testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) testthat::expect_equal(as.numeric(prev[2]), 7.7) # GAM testthat::expect_equal(as.numeric(weighted_pop), 307395) + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-survey-muac_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -359,6 +395,9 @@ testthat::test_that(desc = "Module works well to estimate unweighted-MUAC preval ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -384,6 +423,15 @@ testthat::test_that(desc = "Module works well to estimate unweighted-MUAC preval testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) testthat::expect_equal(as.numeric(prev), 8.0) # GAM testthat::expect_equal(as.numeric(pop), 300) + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-survey-muac_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -460,6 +508,9 @@ testthat::test_that(desc = "Module works well to estimate weighted-combined prev ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -481,6 +532,15 @@ testthat::test_that(desc = "Module works well to estimate weighted-combined prev testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) testthat::expect_equal(as.numeric(prev[2]), 10.8) # GAM testthat::expect_equal(as.numeric(weighted_pop), 288534) + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-survey-combined_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -557,6 +617,9 @@ testthat::test_that(desc = "Module works well to estimate unweighted-combined pr ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -574,6 +637,15 @@ testthat::test_that(desc = "Module works well to estimate unweighted-combined pr testthat::expect_equal(length(app$get_js(js_cols)[1:19]), 19) testthat::expect_equal(as.numeric(prev), 10.5) # GAM testthat::expect_equal(as.numeric(pop), 276) + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-survey-combined_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -656,6 +728,9 @@ testthat::test_that(desc = "Module works well to estimate prevalence from screen ### Click on Estime Prevalence button ---- app$click(input = "prevalence-estimate") app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -685,6 +760,15 @@ testthat::test_that(desc = "Module works well to estimate prevalence from screen testthat::expect_equal(as.numeric(prev_unit_a)[2], 1.2) # SAM testthat::expect_equal(as.numeric(prev_unit_a)[3], 5.3) # MAM testthat::expect_equal(as.numeric(prev_unit_b), 12.4) # Age-weighted GAM + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-screening-age-avail_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() @@ -767,6 +851,9 @@ testthat::test_that(desc = "Prevalence tab works as expected when age is given i app$click(input = "prevalence-estimate") #### Wait until output has been rendered ---- app$wait_for_value(output = "prevalence-results", timeout = 40000) + #### Donwload results ---- + app$wait_for_idle(timeout = 40000) + results <- app$get_download(output = "prevalence-download_results") ### Capture JavaScript expressions to return results's cols and values ---- js_cols <- "$('#prevalence-results thead th').map(function() @@ -796,6 +883,15 @@ testthat::test_that(desc = "Prevalence tab works as expected when age is given i testthat::expect_equal(as.numeric(prev_unit_a)[2], 1.1) # SAM testthat::expect_equal(as.numeric(prev_unit_a)[3], 5.2) # MAM testthat::expect_equal(as.numeric(prev_unit_b), 12.6) # Age-weighted GAM + testthat::expect_equal( + object = basename(results), + paste0( + "mwana-amn-prevalence-screening-age-notavail_", + Sys.Date(), + ".xlsx", + sep = "" + ) + ) ### Stop the app ---- app$stop() From af1ff3177eb1476c0cbd8cedee189ce7dde1ab38 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 18:24:03 +0200 Subject: [PATCH 29/30] disable shinytest2 warning stemming from loadSupport --- R/_disable_autoload.r | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 R/_disable_autoload.r diff --git a/R/_disable_autoload.r b/R/_disable_autoload.r new file mode 100644 index 0000000..e69de29 From 4f3cf4e0d60b5c30b86a49474622b3197cece379 Mon Sep 17 00:00:00 2001 From: tomaszaba Date: Thu, 3 Sep 2026 18:33:41 +0200 Subject: [PATCH 30/30] update title --- README.md | 4 ++-- README.qmd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 0e75f1b..347f438 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -# mwanaApp: A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation +# mwanaApp: A graphical interface to the `mwana` R package for data wrangling, plausibility checks, and prevalence estimation of wasting @@ -33,7 +33,7 @@ The App can be installed from GitHub: ``` r # First install remotes package with: install.package("remotes") -# The install mwana package from GitHub with: +# The install mwana package from GitHub with: remotes::install_github(repo = "mphimo/mwanaApp", dependencies = TRUE) ``` diff --git a/README.qmd b/README.qmd index cae4050..c083c8b 100644 --- a/README.qmd +++ b/README.qmd @@ -2,7 +2,7 @@ format: gfm --- -# mwanaApp: A seamless graphical interface to the mwana R package for data wrangling, plausibility checks, and prevalence estimation +# mwanaApp: A graphical interface to the `mwana` R package for data wrangling, plausibility checks, and prevalence estimation of wasting [![R-CMD-check](https://github.com/mphimo/mwanaApp/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/mphimo/mwanaApp/actions/workflows/R-CMD-check.yaml) @@ -32,7 +32,7 @@ The App can be installed from GitHub: #| eval: false # First install remotes package with: install.package("remotes") -# The install mwana package from GitHub with: +# The install mwana package from GitHub with: remotes::install_github(repo = "mphimo/mwanaApp", dependencies = TRUE) ```