Nothing
#' survey_dat_input UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_survey_dat_input_ui <- function(id){
ns <- NS(id)
fluidPage(
tags$head(
tags$style(HTML("
.checklist-item {
padding: 2px;
border-radius: 2px;
transition: background-color 0.3s ease;
}
.checklist-item:hover {
background-color: #f0f0f0;
}
"))
),
div(class = "module-title",
h4("Data Upload Checklist")),
fluidRow(
column(8,
div(style = " margin: auto;float: left;",
uiOutput(ns("text_display"))
)
),
column(4,
div(style = "display: flex; flex-wrap: wrap;",
uiOutput(ns("checklist"))
)
)
),
tags$hr(style="border-top-color: #E0E0E0;"), # (style="border-top: 2px solid #707070;")
fluidRow(
# Main panel on the left
column(4,
tabsetPanel(id = ns("data_provision_method"),
tabPanel(#"Manual Upload",
title = if (is.null(golem::get_golem_options()$server_link)) "Manual Upload" else "Data Step",
div(style = "margin: auto;float: left;margin-top:10px;",
uiOutput(ns("manual_upload_text"))
),
### upload survey data
div(style = "margin: auto;float: left;width: min(100%,400px);",
fileInput(ns("Svy_dataFile"),
accept='.zip',
with_red_star("Upload DHS survey data (.zip)")),
#actionButton(ns("upload_Svy_Data"), "Submit Survey Data"),
uiOutput(ns("data_button"))
)
),
#tabPanel("Provide Credentials",
# textInput(ns("username"), "Username:"),
# passwordInput(ns("password"), "Password:"),
# actionButton(ns("login_button"), "Login")
#)
)
),
column(
8,
#hr(style = "border-top-color: #E0E0E0;"),
# Add nested tabset for cluster map and raw data preview
tabsetPanel(
tabPanel(
"Cluster Map",
div(style = "margin: auto; float: left; width:min(100%,800px);margin-top: 5px;margin-bottom: 5px",
radioButtons(
ns("AdminLevel"),
"Check out maps for number of clusters at Admin levels",
choices = c("Admin-1"),
inline=T
),
tags$hr(style="border-top-color: #E0E0E0;")
# selectInput(ns("AdminLevel"), "Check out maps for Admin levels",
# choices=character(0))
),
div(style = "margin: auto; float: left;width:max(100%,800px);",
shinyWidgets::materialSwitch(inputId = ns("ClusterMapType"), label = HTML("<strong>Interactive Map Enabled</strong>"),
status = "success",value =T)
),
div(
id = "map-container",
style = "width: min(100%, 800px); margin-top: 5px;height: 100%; overflow-y: auto;",
uiOutput(ns("cluster_map"))
#leaflet::leafletOutput(ns("prev_map"))
)
),
tabPanel(
"Data Preview",
div(style = "margin: auto; float: left; width:100%;margin-top: 15px;",
DT::dataTableOutput(ns("Dat_Preview"))
),
div( style = "width:100%;max-width:1000px; margin-top: 20px; display: flex; justify-content: center;",
uiOutput(ns("download_button_ui"))
)
)
)
)
)
)
}
# @importFrom labelled set_value_labels set_variable_labels
# @importFrom dplyr mutate if_else case_when
#' survey_dat_input Server Functions
#'
#' @noRd
mod_survey_dat_input_server <- function(id,CountryInfo,AnalysisInfo){
moduleServer( id, function(input, output, session){
ns <- session$ns
options(shiny.maxRequestSize=550*1024^2)
# if (!requireNamespace("labelled", quietly = TRUE)) {
# stop("Package 'labelled' is required for this function. Please install it with install.packages('labelled').")
# }
# if (!requireNamespace("naniar", quietly = TRUE)) {
# stop("Package 'naniar' is required for this function. Please install it with install.packages('naniar').")
# }
# if (!requireNamespace("sjlabelled", quietly = TRUE)) {
# stop("Package 'sjlabelled' is required for this function. Please install it with install.packages('sjlabelled').")
# }
if (!requireNamespace("haven", quietly = TRUE)) {
stop("Package 'haven' is required for this function. Please install it with install.packages('haven').")
}
# if (!requireNamespace("data.table", quietly = TRUE)) {
# stop("Package 'data.table' is required for this function. Please install it with install.packages('data.table').")
# }
if (!requireNamespace("dplyr", quietly = TRUE)) {
stop("Package 'dplyr' is required for this function. Please install it with install.packages('dplyr').")
}
### initialize variables for recode
recode_for_ind_abbrev <- reactiveVal(NULL)
recode_for_ind_names <- reactiveVal(NULL)
recode_list_abbrev <- c('IR','PR','KR','BR','HR','MR','AR','CR')
recode_list_names <- c("Individual Recode","Household Member Recode","Children's Recode",
"Births Recode","Household Recode","Men's Recode",
"HIV Test Results Recode","Couples' Recode")
### data upload completion indicator
dat.complete.ind <- reactiveVal(FALSE)
###############################################################
### text instructions on recode
###############################################################
output$text_display <- renderUI({
req(CountryInfo$country())
req(CountryInfo$svy_indicator_var())
### country information
country <- CountryInfo$country()
svy_year <- CountryInfo$svyYear_selected()
admin_level <- CountryInfo$GADM_display_selected_level()
#indicator_description <- surveyPrev_ind_list[surveyPrev_ind_list$ID==input$Svy_indicator,]$Description
### which recode (abbreviation) are needed for this indicator
recode_for_ind_abbrev(recode_list_abbrev[which(ref_tab_all[ref_tab_all$ID==CountryInfo$svy_indicator_var(),
recode_list_abbrev]==T)])
### which recode (full names) are needed for this indicator
recode_for_ind_names(recode_list_names[which(ref_tab_all[ref_tab_all$ID==CountryInfo$svy_indicator_var(),
recode_list_abbrev]==T)])
recode.avail <- check_dat_avail(country =country , svy_year =svy_year , indicator =CountryInfo$svy_indicator_var())
if(length(recode.avail$missing_recode)>0){
return.text <- HTML(paste0(
"<p style='font-size: large;'>",
"<strong> DHS ", svy_year, "</strong> survey ",
"in <strong>", country,"</strong> <br>",
" <font color='red'>does not support estimation </font> for",
"<span style='background-color: #D0E4F7;'>",
"<br> <strong>",CountryInfo$svy_indicator_des(), "</strong>",
"</span>. <br>",
"Please switch to another indicator or survey.",
"</p>"
#"<br>",
#"<hr style='border-top-color: #E0E0E0;'>"
))
return(return.text)
}
### display the recode as, full names (abbreviation), format
recode_for_display <- paste(recode_for_ind_abbrev(), " (", recode_for_ind_names(), ")", sep="")
if(CountryInfo$server_version()){
### load from server text box
return(
HTML(paste0(
"<p style='font-size: large;'>",
"Based on your goal of estimating ",
"<span style='background-color: #D0E4F7;'>",
"<br><strong>", CountryInfo$svy_indicator_des(), "</strong>, ",
"</span><br> in <strong>", country,
"</strong> using the <strong>DHS ", svy_year, "</strong> survey, ",
"<br> the following recode(s) are required for the analysis: ",
"<span style='background-color: #D0E4F7;'>",
"<strong>", concatenate_vector_with_and(recode_for_display), "</strong></span>.",
"</p>"
))
)
}else{
HTML(paste0(
"<p style='font-size: large;'>",
"Based on your goal of estimating ",
"<span style='background-color: #D0E4F7;'>",
"<br> <strong>",CountryInfo$svy_indicator_des(), "</strong>, ",
"</span> <br> in <strong>", country,
"</strong> with <strong> DHS ", svy_year, "</strong> survey ",
"<br> Please upload your data in ",
"<span style='background-color: #D0E4F7;'>",
"<strong>",concatenate_vector_with_and(recode_for_display), "</strong> </span>.",
"</p>"
#"<br>",
#"<hr style='border-top-color: #E0E0E0;'>"
))
}
})
###############################################################
### text instructions on manually upload data
###############################################################
### define the pop up modal containing detailed instructions
inst.modal.text <- reactiveVal(NULL)
# Create a modal using bsModal, defined in the server-side logic
observeEvent(input$triggerModal, {
showModal(
modalDialog(
title = "Detailed Instructions",
inst.modal.text(), # Dynamic content from the server
footer = tagList(
actionButton(ns("closeModal"), "Close") # Button to close the modal
)
)
)
})
# Observer to close the modal when "Close" button is clicked
observeEvent(input$closeModal, {
removeModal()
})
output$manual_upload_text <- renderUI({
req(CountryInfo$country())
req(CountryInfo$svy_indicator_var())
### load from server prompt text
if (CountryInfo$server_version()) {
return(
HTML(paste0(
"<p style='font-size: large; margin-bottom: 20px;'>",
"Please click below to retrieve the survey data from the server and begin your analysis.",
"<hr style='border-top-color: #E0E0E0; margin-top: 20px;'>")))
}
### which file(s) listed on the DHS website to download
dhs_dat_names <- unlist(lapply(recode_for_ind_names(), function(recode) {
find_DHS_dat_name(country= CountryInfo$country(),
svy_year = CountryInfo$svyYear_selected(),
recode=recode)
}))
### which GPS file to download
dhs_GPS_names <- find_DHS_dat_name(country= CountryInfo$country(),
svy_year = CountryInfo$svyYear_selected(),
recode='Geographic Data')
dhs_dat_list_items <- paste0(
"<li><span style='background-color: #D0E4F7; padding: 3px; border-radius: 3px;'><strong>",
toupper(dhs_dat_names),' (',recode_for_ind_names(),')',
"</strong></span></li>"
)
# Combine all items into a single string
dhs_dat_list_items_display <- paste(dhs_dat_list_items, collapse = "")
# Define the HTML content with a refined style
upload_instruct_text <- HTML(paste0(
"<p style='font-size: medium; margin-bottom: 20px; line-height: 2;'>", # Add line-height for larger spacing
"Please follow the steps below to select and download data from the DHS website.<sup>a</sup>", # First footnote reference
"</p>",
"<ol style='font-size: medium; margin-top: 0; margin-bottom: 20px; line-height: 2;'>",
"<li>",
"Navigate to the <a href='https://dhsprogram.com/Data' target = '_blank'><strong>DHS website</strong></a> and locate the download section. ",
"Reference <a href='https://dhsprogram.com/data/Using-DataSets-for-Analysis.cfm' target = '_blank'><strong>this page </strong></a> for detailed instructions.",
"</li>",
"<li>",
"Select data with the following file names: <br>",
"<ul style='list-style-type: disc; margin-left: 20px; line-height: 2;'>",
"<li>",
"Survey Datasets: ",
"<ul style='list-style-type: disc; margin-left: 20px; line-height: 2;'>",
dhs_dat_list_items_display, # Dynamically generated list of survey datasets
"</ul>",
"</li>",
"<li>",
"Geographic Datasets: ",
"<ul style='list-style-type: disc; margin-left: 20px; line-height: 2;'>",
"<li>",
"<span style='background-color: #D0E4F7; padding: 3px; border-radius: 3px;'>",
"<strong>", toupper(dhs_GPS_names), ' (Geographic Data)',"</strong>",
"</span>",
"</li>",
"</ul>",
"</li>",
"</ul>",
"</li>",
"<li>",
"Include all needed files in a single download request.",
"</li>",
"<li>",
"Upload the downloaded <strong>.zip file</strong> using the upload bar provided below.<sup>b</sup>", # Second footnote reference
"</li>",
"</ol>",
"<hr style='border-top-color: #E0E0E0; margin-top: 20px;'>",
"<ol style='font-size: medium; margin-left: 20px; line-height: 2;' type='a'>", # Alphabet indexing for footnotes
"<li>",
"An account is needed for accessing DHS data, please register at ",
"<a href='https://dhsprogram.com/data/new-user-registration.cfm' target = '_blank'><strong>here. </strong></a>",
"The approval process might take up to a few days.",
"</li>",
"<li>",
"If the browser (such as Safari) automatically utils::unzips files on download, please manually re-zip them to a single file and upload.",
"</li>",
"</ol>"
))
inst.modal.text(upload_instruct_text)
HTML(paste0(
"<p style='font-size: large; margin-bottom: 20px;'>",
"Please upload the corresponding DHS datasets, click ",
actionButton(
ns("triggerModal"), # Button ID to trigger the modal
"here",
style = "border: none; background: none; color: blue; padding: 0; margin-bottom: 2px; font-size: large;" # Larger font
),
" for detailed instructions.",
"<hr style='border-top-color: #E0E0E0; margin-top: 20px;'>"))
})
###############################################################
### manually upload data
###############################################################
observeEvent(CountryInfo$server_version(), {
if (CountryInfo$server_version()){
shinyjs::hide("Svy_dataFile")
output$data_button <- renderUI({
#actionButton(ns("preload_Svy_Data"), "Load from Server")
actionButton(ns("preload_Svy_Data"), "Load Data from Server",
style = "color: white; background-color: #0073e6; border-color: #005bb5;")
})
} else {
shinyjs::show("Svy_dataFile")
output$data_button <- renderUI({
actionButton(ns("upload_Svy_Data"), "Upload Survey Data")
})
}
})
observeEvent(CountryInfo$use_preloaded_Zambia(), {
# if(CountryInfo$use_preloaded_Zambia()){
#
# recode.data <- as.data.frame(zmb.ex.IR.dat)
# CountryInfo$update_svy_dat(recode_abbrev='IR', new_dat=recode.data)
#
# GPS.dat <- zmb.ex.GPS
# CountryInfo$svy_GPS_dat(GPS.dat)
#
# }else{return()}
})
observeEvent(CountryInfo$use_preloaded_Madagascar(), {
# if(CountryInfo$use_preloaded_Madagascar()){
#
# recode.data <- as.data.frame(mdg.ex.KR.dat)
# CountryInfo$update_svy_dat(recode_abbrev='KR', new_dat=recode.data)
#
# GPS.dat <- mdg.ex.GPS
# CountryInfo$svy_GPS_dat(GPS.dat)
#
# }else{return()}
})
### load data from server
observeEvent(input$preload_Svy_Data, {
if(is.null(CountryInfo$svyYear_selected()) || CountryInfo$svyYear_selected() == ""){
return(NULL)
}
### check whether all required recode has been uploaded
required_recode <- recode_list_abbrev[which(ref_tab_all[ref_tab_all$ID==CountryInfo$svy_indicator_var(),
recode_list_abbrev]==T)]
#message(required_recode)
recode_status_check <- CountryInfo$check_svy_dat_upload(required_recode,CountryInfo$svy_dat_list())
GPS_status_check <- is.null(CountryInfo$svy_GPS_dat())
### indicator
data.upload.complete <- (all(c(!recode_status_check,!GPS_status_check)))
if(data.upload.complete){
showDataCompleteModal()
return()
}
### set parameters
country_code = CountryInfo$country_code_DHS()
svy_year = CountryInfo$svyYear_selected()
recode_names_abbrev=recode_for_ind_abbrev()
### Check if data for this survey exist on the server
if (F) {
message('This is a survey without preloaded data. Please use the other version.')
showNoFileSelectedModal()
return()
}
message(CountryInfo$country_code_DHS())
message(svy_year)
message(length(recode_for_ind_abbrev()))
message(recode_for_ind_abbrev())
new_dat_num <- 0
## set survey recode data
for (i in 1:length(recode_names_abbrev)){
### check whether the data was already uploaded
if(!CountryInfo$check_svy_dat_upload(recode_names_abbrev[i],CountryInfo$svy_dat_list())){
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0(recode_names_abbrev[i]," Recode already loaded, skip.")))
Sys.sleep(0.5)
session$sendCustomMessage('controlSpinner', list(action = "hide"))
next
}
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0("Loading ",recode_names_abbrev[i]," Recode. Please wait...")))
Sys.sleep(1)
recode.path <- paste0(golem::get_golem_options()$server_link,'/',
country_code,'/DHS_',svy_year,'/',
recode_names_abbrev[i],'.rds'
)
#message(recode.path)
#recode.data <- readRDS(recode.path)
recode.data <- tryCatch(
{
readRDS(url(recode.path))
#readRDS((recode.path))
},
error = function(e) {
message("Failed to retrieve ",recode_names_abbrev[i], ' from the server.')
message("Error: ", e$message)
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0("Fail to retrieve ",
recode_names_abbrev[i],
" recode from the server. Please contact us.")))
Sys.sleep(2.5)
NULL # return NULL if not found
}
)
if(!is.null(recode.data)){
CountryInfo$update_svy_dat(recode_abbrev=recode_for_ind_abbrev()[i], new_dat=recode.data)
new_dat_num <- new_dat_num+1
}
session$sendCustomMessage('controlSpinner', list(action = "hide"))
}
### set survey GPS data
if(is.null( CountryInfo$svy_GPS_dat())){
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'Loading Geographic Data. Please wait...')))
GPS.path <- paste0(golem::get_golem_options()$server_link,'/',
country_code,'/DHS_',svy_year,'/',
'Geographic_Data.rds'
)
message(GPS.path)
GPS.dat <- tryCatch(
{
readRDS(url(GPS.path))
#readRDS((GPS.path))
},
error = function(e) {
message("Failed to retrieve GPS data from the server.")
message("Error: ", e$message)
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0("Fail to retrieve GPS data from the server. Please contact us.")))
Sys.sleep(2.5)
NULL # return NULL if not found
}
)
Sys.sleep(1)
if(!is.null(GPS.dat)){
CountryInfo$svy_GPS_dat(GPS.dat)
new_dat_num <- new_dat_num+1
}
session$sendCustomMessage('controlSpinner', list(action = "hide"))
}
if(new_dat_num==0){
message('No new updata found.')
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'No other required recode found on the server for this indicator. ',
"Please contact us if there is any recode missing.")))
Sys.sleep(3)
session$sendCustomMessage('controlSpinner', list(action = "hide"))
}
#message(tmp.list)
#message(CountryInfo$svy_GPS_dat())
})
observeEvent(input$upload_Svy_Data, {
# Check if a file has been uploaded
if (is.null(input$Svy_dataFile)&
!(paste0(CountryInfo$country_code_DHS(),'_',CountryInfo$svyYear_selected(),'_DHS.zip') %in%
list.files(system.file("preloaded_DHS", package = "sae4health")))
) {
message('This is a survey without preloaded data, and no data was uploaded.')
showNoFileSelectedModal()
return()
}
# if (is.null(input$Svy_dataFile)) {
# showNoFileSelectedModal()
# return()
# }
### check whether all required recode has been uploaded
required_recode <- recode_list_abbrev[which(ref_tab_all[ref_tab_all$ID==CountryInfo$svy_indicator_var(),
recode_list_abbrev]==T)]
#message(required_recode)
recode_status_check <- CountryInfo$check_svy_dat_upload(required_recode,CountryInfo$svy_dat_list())
GPS_status_check <- is.null(CountryInfo$svy_GPS_dat())
### indicator
data.upload.complete <- (all(c(!recode_status_check,!GPS_status_check)))
if(data.upload.complete){
showDataCompleteModal()
return()
}
#req(input$Svy_dataFile)
# set parameters
country= CountryInfo$country()
svy_year = CountryInfo$svyYear_selected()
recode_names_list=recode_for_ind_names()
### check whether data is available inside the app, if so, load the data, no need to upload
if(paste0(CountryInfo$country_code_DHS(),'_',CountryInfo$svyYear_selected(),'_DHS.zip') %in%
list.files(system.file("preloaded_DHS", package = "sae4health"))){
file_path <- system.file("preloaded_DHS",
paste0(CountryInfo$country_code_DHS(),'_',CountryInfo$svyYear_selected(),'_DHS.zip'),
package = "sae4health")
message('Use preloaded data.')
message(CountryInfo$country_code_DHS())
}else{
message('Use user uploaded data.')
file_path <- input$Svy_dataFile$datapath
}
new_dat_num <- 0
## set survey recode data
for (i in 1:length(recode_names_list)){
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0("Parsing .zip files. Please wait...")))
file_prefix <- find_DHS_dat_name(country,svy_year,recode =recode_names_list[i] )
recode_path_found <- find_recode_path(file_path = file_path,
recode_file =file_prefix,
extensions = 'DTA')
session$sendCustomMessage('controlSpinner', list(action = "hide"))
if(!is.null(recode_path_found)){
#message(paste0(recode_names_list[i] ,' recode found at: ',(recode_path_found)))
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0(recode_names_list[i],
" found, loading...")))
recode.data <- suppressWarnings(haven::read_dta(recode_path_found))
recode.data <- as.data.frame(recode.data)
#mdg.ex.KR.dat <- recode.data
#recode.data <- as.data.frame(zmb.ex.IR.dat)
#Sys.sleep(1)
CountryInfo$update_svy_dat(recode_abbrev=recode_for_ind_abbrev()[i], new_dat=recode.data)
new_dat_num <- new_dat_num+1
#message(paste0(recode_for_ind_abbrev()[i]))
session$sendCustomMessage('controlSpinner', list(action = "hide"))
}
}
## set survey GPS data
GPS_prefix <- find_DHS_dat_name(country,svy_year,recode = 'Geographic Data' )
GPS_path_found <- find_recode_path(file_path = file_path,
recode_file = GPS_prefix,
extensions = 'shp')
#message(GPS_path_found)
if(!is.null(GPS_path_found)){
#message(paste0(GPS_prefix ,' recode found at: ',(GPS_path_found)))
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'Geographic Data',
" found, loading...")))
GPS.dat <- suppressWarnings(sf::st_read(GPS_path_found))
GPS.dat <- sf::st_set_crs(GPS.dat, 4326)
Sys.sleep(1)
CountryInfo$svy_GPS_dat(GPS.dat)
new_dat_num <- new_dat_num+1
session$sendCustomMessage('controlSpinner', list(action = "hide"))
if(FALSE){
### assigning cluster and admin information
gadm.names <- names(CountryInfo$GADM_list())
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0("Processing cluster GPS information, please wait")))
for(adm.level in gadm.names){
message(adm.level)
tmp.cluster.adm.info <- cluster_admin_info(cluster.geo= GPS.dat, #mdg.ex.GPS
gadm.list = CountryInfo$GADM_list(), #mdg.ex.GADM.list
model.gadm.level = admin_to_num(adm.level),
strat.gadm.level = CountryInfo$GADM_strata_level())
AnalysisInfo$set_info_list(adm.level,tmp.cluster.adm.info)
}
session$sendCustomMessage('controlSpinner', list(action = "hide"))
}
}
if(new_dat_num==0){
message('No new updata uploaded.')
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'No required data found for this indicator .',
"Please check out instructions for downloading survey data.")))
Sys.sleep(2.5)
session$sendCustomMessage('controlSpinner', list(action = "hide"))
}
#message(tmp.list)
#message(CountryInfo$svy_GPS_dat())
})
###############################################################
### cluster map
###############################################################
### determine static vs interactive
observeEvent(input$ClusterMapType,{
CountryInfo$display_interactive(input$ClusterMapType)
})
observeEvent(CountryInfo$display_interactive(),{
interactive_map <- CountryInfo$display_interactive()
shinyWidgets::updateMaterialSwitch(session=session, inputId="ClusterMapType", value = interactive_map)
})
### determine which UI to present plot
output$cluster_map <- renderUI({
if (input$ClusterMapType) { # if TRUE, show interactive map
leaflet::leafletOutput(ns("cluster_map_interactive"))
} else { # if FALSE, show static map
plotOutput(ns("cluster_map_static"))
}
})
### update admin-levels
observe({
req(CountryInfo$GADM_list())
gadm.names <- names(CountryInfo$GADM_list())
gadm.names <- gadm.names[gadm.names!='National']
if(length(gadm.names)>0){
updateRadioButtons(session, "AdminLevel", choices = gadm.names,
inline = T)
}
})
output$cluster_map_interactive <- leaflet::renderLeaflet({
req(CountryInfo$GADM_list())
req(CountryInfo$svy_GPS_dat())
### initialize base map
cluster.interactive.plot <- leaflet::leaflet()
if(CountryInfo$use_basemap()=='OSM'){
cluster.interactive.plot <- cluster.interactive.plot %>% leaflet::addTiles()
}
### return empty map if no subnational level selected
if (length(input$AdminLevel) == 0 || input$AdminLevel == ""||is.null(CountryInfo$GADM_list())||
is.null(CountryInfo$svy_GPS_dat())) {
return(cluster.interactive.plot)
}
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'Calculating Cluster ',
"Info...")))
ncluster.res <- ncluster.map.interactive(gadm.level=input$AdminLevel,
gadm.list=CountryInfo$GADM_list(),
cluster.geo=CountryInfo$svy_GPS_dat(),
use.basemap = CountryInfo$use_basemap(),
legend.color.reverse=CountryInfo$legend_color_reverse())
session$sendCustomMessage('controlSpinner', list(action = "hide"))
return(ncluster.res$map)
})
output$cluster_map_static <- renderPlot({
req(CountryInfo$GADM_list())
req(CountryInfo$svy_GPS_dat())
### return empty map if no subnational level selected
if (length(input$AdminLevel) == 0 || input$AdminLevel == ""||is.null(CountryInfo$GADM_list())||
is.null(CountryInfo$svy_GPS_dat())) {
return(NULL)
}
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'Calculating Cluster ',
"Info...")))
ncluster.res <- ncluster.map.static(gadm.level=input$AdminLevel,
gadm.list=CountryInfo$GADM_list(),
cluster.geo=CountryInfo$svy_GPS_dat())
session$sendCustomMessage('controlSpinner', list(action = "hide"))
return(ncluster.res$map)
})
###############################################################
### Data preview
###############################################################
### when survey uploaded or new indicator specified, update analysis data set
data_pre_snapshot <- reactive({
list(
indicator_selected = CountryInfo$svy_indicator_var(),
svy_dat_uploaded = CountryInfo$svy_dat_list()
)
})
### prepare analysis data set
observeEvent(data_pre_snapshot(),{
### check whether all required recode has been uploaded
required_recode <- recode_list_abbrev[which(ref_tab_all[ref_tab_all$ID==CountryInfo$svy_indicator_var(),
recode_list_abbrev]==T)]
#message(required_recode)
recode_status_check <- CountryInfo$check_svy_dat_upload(required_recode,CountryInfo$svy_dat_list())
GPS_status_check <- is.null(CountryInfo$svy_GPS_dat())
### indicator
data.upload.complete <- (all(c(!recode_status_check,!GPS_status_check)))
if(!data.upload.complete){
return()
}
analysis_dat <- NULL
CountryInfo$svy_analysis_dat(NULL)
tryCatch({
svy_dat_list <- CountryInfo$svy_dat_list()
#svy_dat_recode <- svy_dat_list[[recode_for_ind_abbrev()[1]]]
if(length(required_recode)>1){
svy_dat_recode <- NULL
svy_dat_recode <- svy_dat_list[required_recode]
names(svy_dat_recode) <- as.character(get_recode_names(required_recode))
}else{
svy_dat_recode <- NULL
svy_dat_recode <- svy_dat_list[[required_recode]]
}
session$sendCustomMessage('controlSpinner', list(action = "show",
message = paste0( 'Preparing analysis dataset, ',
"please wait...")))
#analysis_dat <- surveyPrev::getDHSindicator(Rdata=svy_dat_recode,
# indicator = CountryInfo$svy_indicator_var())
# message(CountryInfo$country())
# message(CountryInfo$svyYear_selected())
# message(recode_for_ind_abbrev())
### correct Nigeria wrong data point in HR recode
if(CountryInfo$country()=='Nigeria' &&
CountryInfo$svyYear_selected()==2018 &&
('PR' %in% recode_for_ind_abbrev()||
'HR' %in% recode_for_ind_abbrev())){
message('correcting Nigeria 2018 HR recode')
svy_dat_recode[svy_dat_recode$hv001=="1270","hv025"] = 2
}
# library(sn) ## for INLA to run, just declare here with other packages
# library(labelled)
# library(naniar)
# library(sjlabelled)
# library(dplyr)
# library(data.table)
# library(haven)
message(CountryInfo$svy_indicator_var())
#message(CountryInfo$svy_indicator_var() %in% match_all_result$indicator_ID_DHS)
analysis_dat <- surveyPrev::getDHSindicator(Rdata=svy_dat_recode,
indicator = CountryInfo$svy_indicator_var())
#data('match_all_result', package = "surveyPrev")
# if(CountryInfo$svy_indicator_var() %in% ref_tab_new$ID){
#
# #analysis_dat_fun = utils::getFromNamespace(CountryInfo$svy_indicator_var(), "surveyPrev")
# analysis_dat = surveyPrev::getDHSindicator(Rdata=svy_dat_recode, indicator = NULL, FUN =CountryInfo$svy_indicator_var())
#
# #analysis_dat = surveyPrev::getDHSindicator(Rdata=svy_dat_recode, indicator = NULL, FUN =analysis_dat_fun)
# #detach("package:data.table", unload=TRUE)
# }else{
#
# analysis_dat <- surveyPrev::getDHSindicator(Rdata=svy_dat_recode,
# indicator = CountryInfo$svy_indicator_var())
# }
CountryInfo$svy_analysis_dat(analysis_dat)
}, error = function(e) {
message(e$message)
})
session$sendCustomMessage('controlSpinner', list(action = "hide"))
### check whether analysis data set is properly produced
tryCatch({
if(is.null(analysis_dat)){
showModal(modalDialog(
title = "Failed to Prepare Analysis Dataset",
paste0("An error occurred while generating the analysis dataset. ",
"This issue may stem from country-specific variable coding that ",
"doesn't align with our general coding for the selected indicator. ",
"Please try selecting a different survey or indicator for your analysis. ",
"We encourage you to report this issue to the developer, ",
"as your feedback will help improve the app."),
easyClose = TRUE,
footer = modalButton("OK")
))
}
}, error = function(e) {
message(e$message)
})
### produce national estimates
gadm.list <- CountryInfo$GADM_list()
cluster.geo <- CountryInfo$svy_GPS_dat()
analysis.dat <- CountryInfo$svy_analysis_dat()
cluster.info <- surveyPrev::clusterInfo(geo=cluster.geo,
poly.adm1=gadm.list[[paste0('Admin-',1)]],
poly.adm2=gadm.list[[paste0('Admin-',1)]],
by.adm1 = paste0("NAME_",1),
by.adm2 = paste0("NAME_",1))
res_adm <- tryCatch({
# First attempt with alt.strata='v022'
surveyPrev::directEST(data = analysis.dat,
cluster.info = cluster.info,
admin = 0,
strata = "all",
alt.strata = 'v022')
}, error = function(e) {
# If the first attempt fails, try with alt.strata=svy.strata
tryCatch({
surveyPrev::directEST(data = analysis.dat,
cluster.info = cluster.info,
admin = 0,
strata = "all",
alt.strata = NULL)
}, error = function(e) {
# If both attempts fail, set res_adm to NULL
NULL
})
})
if (!is.null(res_adm)) {
AnalysisInfo$Natl_res(res_adm$res.admin0)
}
session$sendCustomMessage('controlSpinner', list(action = "hide"))
### check whether indicator has too many missing
tryCatch({
if(!is.null(analysis_dat)){
ind_missing = sum(is.na(analysis_dat$value))/dim(analysis_dat)[1]
ind_percent_missing = floor(ind_missing*100)
#if(ind_percent_missing>=99 & (!'HR' %in% recode_for_ind_abbrev())){
if(ind_percent_missing>=99){
showModal(modalDialog(
title = "Too many missing values for this indicator",
paste0(ind_percent_missing, "% of records have missing data."),
easyClose = TRUE,
footer = modalButton("OK")
))
}
}
}, error = function(e) {
message(e$message)
})
})
### analysis set data set preview
output$Dat_Preview <- DT::renderDataTable({
req(CountryInfo$svy_dat_list())
req(CountryInfo$svy_indicator_var())
if(!dat.complete.ind()){
return()
}
analysis_dat <-CountryInfo$svy_analysis_dat()
if(is.null(analysis_dat)){return()
}else{
analysis_dat <- haven::as_factor(analysis_dat)
### do not display strata info for WHO version of the app
if(CountryInfo$WHO_version()){
analysis_dat <- analysis_dat[ , !(names(analysis_dat) %in% c('v024'))]
}
message(colnames(analysis_dat))
if(CountryInfo$server_version()){
set.seed(2025)
subset_analysis_dat <- analysis_dat[sample(nrow(analysis_dat), 25), ]
subset_analysis_dat <- subset_analysis_dat[ , !(names(subset_analysis_dat) %in% c('householdID'))]
dt <- DT::datatable(subset_analysis_dat,
options = list(pageLength = 5,scrollX = TRUE,
scroller = TRUE),
filter = 'top', rownames = FALSE,
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left; font-weight: bold;',
'Note: only a small subset of data is shown due to confidentiality.'
))
# Apply formatting styles
dt <- DT::formatStyle(dt,
columns = names(subset_analysis_dat),
backgroundColor = 'rgba(255, 255, 255, 0.8)',
border = '1px solid #ddd',
fontSize = '14px',
fontWeight = 'normal',
lineHeight = '1.42857143')
}else{
dt <- DT::datatable(analysis_dat,
options = list(pageLength = 5,scrollX = TRUE,
scroller = TRUE),
filter = 'top', rownames = FALSE)
# Apply formatting styles
dt <- DT::formatStyle(dt,
columns = names(analysis_dat),
backgroundColor = 'rgba(255, 255, 255, 0.8)',
border = '1px solid #ddd',
fontSize = '14px',
fontWeight = 'normal',
lineHeight = '1.42857143')
}
dt
#DT::datatable(analysis_dat)
}
})
### download button - analysis data set
output$download_button_ui <- renderUI({
analysis_dat <-CountryInfo$svy_analysis_dat()
if(!CountryInfo$server_version()){
# csv download
downloadButton(ns("download_csv"), "Download as csv", icon = icon("download"),
class = "btn-primary")
} else {
NULL
}
# if(!paste0(CountryInfo$country_code_DHS(),'_',CountryInfo$svyYear_selected(),'_DHS.zip') %in%
# list.files(system.file("preloaded_DHS", package = "sae4health"))){
# # csv download
# downloadButton(ns("download_csv"), "Download as csv", icon = icon("download"),
# class = "btn-primary")
# } else {
# NULL
# }
})
### download analysis data set
output$download_csv <- downloadHandler(
filename = function() {
file.prefix <- paste0(CountryInfo$country(),'_',
CountryInfo$svy_indicator_var(),'_')
file.prefix <- gsub("[-.]", "_", file.prefix)
return(paste0(file.prefix,'raw_data.csv'))
},
content = function(file) {
analysis_dat <- as.data.frame(CountryInfo$svy_analysis_dat())
readr::write_csv(analysis_dat, file)
}
)
###############################################################
### Generate checklist UI
###############################################################
output$checklist <- renderUI({
req(recode_for_ind_abbrev())
#message(recode_for_ind_abbrev())
recode_status_check <- CountryInfo$check_svy_dat_upload(recode_for_ind_abbrev(),CountryInfo$svy_dat_list())
#message(recode_status_check)
GPS_status_check <- is.null(CountryInfo$svy_GPS_dat())
## update data upload status, if all uploaded, complete=T
dat.complete.ind(all(c(!recode_status_check,!GPS_status_check)))
#message((c(!recode_status_check,!GPS_status_check)))
#message(dat.complete.ind())
tagList(
div(style = "margin-top: -5px;margin-bottom: -10px",
tags$h4("Upload Checklist:")
),
### display progress once indicator selected
lapply(1:length(recode_for_ind_abbrev()), function(i) {
checklistItem(paste(recode_for_ind_abbrev()[i],' Recode'), !recode_status_check[i])
}),
checklistItem(paste("GPS data"), !GPS_status_check)
)
})
})
}
checklistItem <- function(name, completed = FALSE) {
icon <- if(completed) "fas fa-check-circle" else "fas fa-times-circle"
color <- if(completed) "green" else "orange"
statusText <- if(completed) "Completed" else "Pending"
tags$div(class = "checklist-item",
tags$i(class = icon, style = sprintf("color: %s; margin-right: 5px;", color)),
tags$span(style = sprintf("color: %s;", color), sprintf("%s: %s", name, statusText)),
style = "margin-bottom: -2px; cursor: pointer;font-size: 1.2em;"
#onclick = sprintf("this.style.opacity = '%s'", if(completed) "0.5" : "1")
)
}
## To be copied in the UI
# mod_survey_dat_input_ui("survey_dat_input_1")
## To be copied in the server
# mod_survey_dat_input_server("survey_dat_input_1")
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.