From caf107fb8ef0bf6aaf9e25db8ad4fede14dd1802 Mon Sep 17 00:00:00 2001 From: Edouard Date: Mon, 30 Oct 2023 23:58:53 -0500 Subject: [PATCH] rev --- DESCRIPTION | 10 +- NAMESPACE | 13 ++ R/app_server.R | 3 + R/body.R | 5 +- R/header.R | 4 +- R/kobo_dummy.R | 219 +++++++++++++++++++++++++++++++++ R/mod_apply_calculation.R | 60 +++++++++ R/mod_home.R | 41 ++++--- R/mod_remap_code.R | 60 +++++++++ R/mod_variable_mapping.R | 60 +++++++++ R/plot_rbm_sdg.R | 214 ++++++++++++++++++++++++++++++++ R/sidebar.R | 5 +- R/var_dummy.R | 182 +++++++++++++++++++++++++++ README.Rmd | 12 +- dev/01_dev.R | 5 +- dev/config_fusen.yaml | 19 +++ dev/indicators.Rmd | 252 ++++++++++++++++++++++++++------------ dev/utilities.Rmd | 39 ++++-- 18 files changed, 1084 insertions(+), 119 deletions(-) create mode 100644 R/kobo_dummy.R create mode 100644 R/mod_apply_calculation.R create mode 100644 R/mod_remap_code.R create mode 100644 R/mod_variable_mapping.R create mode 100644 R/plot_rbm_sdg.R create mode 100644 R/var_dummy.R diff --git a/DESCRIPTION b/DESCRIPTION index b654318..ec5b395 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,28 +15,34 @@ URL: https://github.com/unhcr-americas/IndicatorCalc Imports: cli, config, + countrycode, dplyr, ggforce, ggplot2, ggtext, golem, + janitor, + kobocruncher, labelled, plyr, purrr, + SDGsR, shiny, shinydashboard, showtext, sjlabelled, sjmisc, + stats, + stringr, sysfonts, systemfonts, tibble, tidyr, unhcrshiny, - unhcrthemes + unhcrthemes, + withr Suggests: knitr, - kobocruncher, rmarkdown, testthat VignetteBuilder: diff --git a/NAMESPACE b/NAMESPACE index 63a3002..7a7fccd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,16 +9,24 @@ export(inter_drinkingwater) export(inter_electricity) export(inter_healthcare) export(inter_shelter) +export(kobo_dummy) export(run_app) +export(var_dummy) import(golem) import(shiny) import(shinydashboard) +import(tidyverse) +importFrom(SDGsR,get_indicator) importFrom(cli,cli_alert_info) +importFrom(countrycode,countrycode) importFrom(dplyr,case_when) importFrom(dplyr,filter) importFrom(dplyr,mutate) +importFrom(dplyr,n) importFrom(dplyr,pull) +importFrom(dplyr,rename) importFrom(dplyr,row_number) +importFrom(dplyr,tibble) importFrom(ggforce,geom_arc_bar) importFrom(ggplot2,aes) importFrom(ggplot2,expansion) @@ -30,13 +38,18 @@ importFrom(golem,add_resource_path) importFrom(golem,bundle_resources) importFrom(golem,favicon) importFrom(golem,with_golem_options) +importFrom(janitor,clean_names) +importFrom(kobocruncher,kobo_dico) importFrom(labelled,labelled) importFrom(purrr,imap) importFrom(purrr,list_rbind) importFrom(shiny,shinyApp) +importFrom(stats,rlnorm) +importFrom(stringr,str_replace) importFrom(tibble,as_tibble_col) importFrom(tibble,tibble) importFrom(tidyr,unnest) importFrom(unhcrshiny,theme_shinydashboard_unhcr) importFrom(unhcrthemes,scale_fill_unhcr_d) importFrom(unhcrthemes,theme_unhcr) +importFrom(withr,with_seed) diff --git a/R/app_server.R b/R/app_server.R index 40780fe..10817c7 100755 --- a/R/app_server.R +++ b/R/app_server.R @@ -12,4 +12,7 @@ app_server <- function(input, output, session) { AppReactiveValue <- reactiveValues() # pins::board_register() # connect to pin board if needed callModule(mod_home_server, "home_ui_1") + callModule(mod_variable_mapping_server, "variable_mapping_ui_1", AppReactiveValue) + callModule(mod_remap_code_server, "remap_code_ui_1", AppReactiveValue) + callModule(mod_apply_calculation_server, "apply_calculation_ui_1", AppReactiveValue) } diff --git a/R/body.R b/R/body.R index 24c1feb..66902f3 100755 --- a/R/body.R +++ b/R/body.R @@ -16,7 +16,10 @@ body <- function() { ), shinydashboard::tabItems( #Add ui module here - separated with a coma! - mod_home_ui("home_ui_1") + mod_home_ui("home_ui_1"), + mod_variable_mapping_ui("variable_mapping_ui_1"), + mod_remap_code_ui("remap_code_ui_1"), + mod_apply_calculation_ui("apply_calculation_ui_1") ) ) } diff --git a/R/header.R b/R/header.R index 055ecb7..7c89972 100644 --- a/R/header.R +++ b/R/header.R @@ -1,6 +1,4 @@ header <- function() { shinydashboard::dashboardHeader( - title = tagList( - span(class = 'logo-lg',a("IndicatorCalc",style="color:white !important",href='https://rstudio.unhcr.org/IndicatorCalc')), - ) ) + title = "IndicatorCalc") } diff --git a/R/kobo_dummy.R b/R/kobo_dummy.R new file mode 100644 index 0000000..6acf505 --- /dev/null +++ b/R/kobo_dummy.R @@ -0,0 +1,219 @@ +# WARNING - Generated by {fusen} from dev/utilities.Rmd: do not edit by hand + +#' kobo_dummy +#' +#' @description Automatically produce an dummy dataset in line with the structure +#' of an XlsForm +#' Making decisions about research design and analysis strategies is often difficult before data is collected, +#' because it is hard to imagine the exact form data will take. +#' This function helps imagine what data will look like before they collect it. +#' samplesize is set per defautl at 500 records +#' +#' Supported Features: +#' - Generate a data set +#' - respects ODK structure "`relevant`" skip logic +#' (Some advanced functionality such as "coalesce()" not covered) +#' - respects "`constraint`" +#' - respects "`repeat`" adds ID column to link hierarchical data based on "`repeat_count`" +#' This function is a rewriting of +#' https://unhcr.github.io/koboloadeR/docs/reference/kobo_dummy.html +#' it also build on https://thinkr-open.github.io/fakir/ and +#' https://docs.ropensci.org/charlatan/ +#' +#' @param form file path of the XlsForm +#' @param n number of main records to be generated +#' @param nrepeat max random number of repeat records to be generated +#' when repeat_count is not mentionned +#' @param file file as xlsx where to save to the +#' +#' @importFrom kobocruncher kobo_dico +#' +#' +#' @return a data list with a series of dummy data +#' +#' @export +#' @examples +#' form <- system.file("RMSCAPI.xlsx", package = "IndicatorCalc") +#' datalist <- kobo_dummy(form, +#' n = 384, +#' file = NULL) +kobo_dummy <- function(form, + n = 384, + file){ + + dico <- kobocruncher::kobo_dico(xlsformpath = form) + + ## Get the variables to extract + frame <- "main" + + conf <- data.frame( + name <- dico[["variables"]] |> + dplyr::filter(repeatvar == frame) |> + dplyr::select(name), + + # dico[["variables"]]|> + # dplyr::filter(repeatvar == frame) |> + # dplyr::distinct(type) + type <- dico[["variables"]]|> + dplyr::filter(repeatvar == frame) |> + dplyr::select(type), + + ## pulling list options... + list_opt <- dico[["variables"]] |> + dplyr::filter(repeatvar == frame) |> + dplyr::select(list_name) , + #dplyr::left_join(modal, by = c("list_name")) |> + # dplyr::select( list_opt) + + + constraint <- dico[["variables"]]|> + dplyr::filter(repeatvar == frame) |> + dplyr::select(constraint) + ) + + ## We start with the generation of the main frame + ## Build the main table and initiate it an index..... + main <- dplyr::tibble( + index = paste0( "ID-", + purrr::as_vector( + purrr::map(n, sample(LETTERS, 4)) |> + purrr::map(paste0, collapse = "")), + "-", + formatC(1:n, width = nchar(n) + 1, flag = "0") + )) + + ## then apply var_dummy interactively... + for(i in (1:nrow(conf)) ) { + # i <- 6 + cat(paste0(i, "-", conf[i, c("type")], "-", conf[i, c("name")], "\n")) + + ## manage specific case when list name is not defined in ccoices but pulled from data.. + ## in such case we replace type by select_one by text + this.type <- conf[i, c("type")] + this.name <- conf[i, c("name")] + this.listname <- conf[i , c("list_name")] + this.constraint = conf[i, c("constraint")] + + if( !(this.listname %in% c( dico[["modalities"]] |> dplyr::pull(list_name))) ) { + this.listname <- NULL + this.type <- "text" + } + + main <- var_dummy( + frame = main, + name = this.name, + type = this.type, + list_opt = c(dico[["modalities"]] |> + dplyr::filter(list_name == this.listname ) |> + dplyr::pull(name) ), + constraint = this.constraint ) + } + + ## Still struggling with purrr + # test <- purrr::map( main, + # name, + # type, + # list_opt$list_opt , + # constraint , + # var_dummy) + + ## TODO -- apply the relevance statement... + ## define when the variable should exist based on other elements + ## Need to convert the xlsform statement into R syntax + # relevant <- dico[["variables"]]|> + # dplyr::filter(repeatvar == "main") |> + # dplyr::pull(relevant) + + ## replace \" by ' + ## replace '=' by '==" + ## replace '!==' by '!=" (to fix previsous replace) + ## replace '${' '}' with nothing.. + ## replace 'or' with '|'.. + ## replace 'and' with '&'.. + + ## Now store in the list... + datalist <- list ( "main" = main) + + ## treat cases with repeat table.. ##### + repeatvar <- dico[["variables"]] |> + dplyr::select(repeatvar) |> + dplyr::filter(repeatvar != "main") |> + dplyr::distinct() |> + dplyr::pull() + ## need to separate the different repeat elements wthin the form... + for ( rep in repeatvar ) { + + confrep <- data.frame( + name <- dico[["variables"]] |> + dplyr::filter(repeatvar == rep) |> + dplyr::select(name), + + # dico[["variables"]]|> + # dplyr::filter(repeatvar == rep) |> + # dplyr::distinct(type) + type <- dico[["variables"]]|> + dplyr::filter(repeatvar == rep) |> + dplyr::select(type), + + ## pulling list options... + list_opt <- dico[["variables"]] |> + dplyr::filter(repeatvar == rep) |> + dplyr::select(list_name) , + #dplyr::left_join(modal, by = c("list_name")) |> + # dplyr::select( list_opt) + + + constraint <- dico[["variables"]]|> + dplyr::filter(repeatvar == rep) |> + dplyr::select(constraint) + ) + + ## We start with the generation of the main frame + ## Build the main table and initiate it an index..... + repframe <- dplyr::tibble( + index = paste0( "ID-", + purrr::as_vector( + purrr::map(n, sample(LETTERS, 4)) |> + purrr::map(paste0, collapse = "")), + "-", + formatC(1:n, width = nchar(n) + 1, flag = "0") + )) + + ## then apply var_dummy interactively... + for(i in (1:nrow(confrep)) ) { + # i <- 6 + cat(paste0(i, " in repeat -", rep, " ///", confrep[i, c("type")], "-", confrep[i, c("name")], "\n")) + + ## manage specific case when list name is not defined in ccoices but pulled from data.. + ## in such case we replace type by select_one by text + this.type <- confrep[i, c("type")] + this.name <- confrep[i, c("name")] + this.listname <- confrep[i , c("list_name")] + this.constraint = confrep[i, c("constraint")] + + if( !(this.listname %in% c( dico[["modalities"]] |> dplyr::pull(list_name))) ) { + this.listname <- NULL + this.type <- "text" + } + + repframe <- var_dummy( + frame = repframe, + name = this.name, + type = this.type, + list_opt = c(dico[["modalities"]] |> + dplyr::filter(list_name == this.listname ) |> + dplyr::pull(name) ), + constraint = this.constraint ) + } + + ## TODO -- check if we have a `repeat_count` to apply limitation.. + + ## append to the repeat + datalist[[rep]] <- repframe + } + + + + + return(datalist) + } diff --git a/R/mod_apply_calculation.R b/R/mod_apply_calculation.R new file mode 100644 index 0000000..949334b --- /dev/null +++ b/R/mod_apply_calculation.R @@ -0,0 +1,60 @@ +#' Module UI + +#' @title mod_apply_calculation_ui and mod_apply_calculation_server +#' @description A shiny module. +#' @description A shiny module. +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' @import shiny +#' @import shinydashboard +#' @keywords internal + +mod_apply_calculation_ui <- function(id) { + ns <- NS(id) + tabItem( + tabName = "apply_calculation", + fluidRow( + column( + width = 12, + h2('Now apply the calculations'), + p("You can now apply the standard calculations") + ) + ), + + fluidRow( + shinydashboard::box( + title = "Module Step", + # status = "primary", + status = "info", + solidHeader = FALSE, + collapsible = TRUE, + width = 12, + "Content" +## do not forget that all elements ID of the GUI needs to be called with ns("ID").... + ) + + ) + ) +} + +#' Module Server +#' @noRd +#' @import shiny +#' @import tidyverse +#' @keywords internal + +mod_apply_calculation_server <- function(input, output, session, AppReactiveValue) { + ns <- session$ns +## add here the server logic part of your module.... +} + +## copy to body.R +# mod_apply_calculation_ui("apply_calculation_ui_1") + +## copy to sidebar.R +# shinydashboard::menuItem("displayName",tabName = "apply_calculation",icon = icon("user")) + +## and copy to app_server.R +# callModule(mod_apply_calculation_server, "apply_calculation_ui_1", AppReactiveValue) + diff --git a/R/mod_home.R b/R/mod_home.R index 880227e..bcfa788 100644 --- a/R/mod_home.R +++ b/R/mod_home.R @@ -15,29 +15,32 @@ mod_home_ui <- function(id) { id = "splash_panel", top = 0, left = 0, right = 0, bottom = 0, ### Get the name for your tool p( - tags$span("Dashboard ", style = "font-size: 60px"), - tags$span("template", style = "font-size: 24px") + tags$span("IndicatorCalc ", style = "font-size: 60px"), + tags$span(" Beta", style = "font-size: 24px") ), br(), ### Then a short explainer - p(paste("Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do - eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad - minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip - ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate - velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat - cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."), + p( "The calculation of Standard Indicators is a key step in the analysis of Household survey dataset. + UNHCR Results Monitoring Survey is based on international statistical standards and definitions, + comes with standardised calculation to apply and can appear complex + as sometime a single indicator might imply to compile more than 15 different variables", style = "font-size: 20px"), - br(), - fluidRow( - actionButton(NS(id, "go_to_firstmod"), - label = "Start Exploring", - width = "150px", - style='font-size: 16px; color: #18375F', - icon = icon("chevron-right")), - style = "font-size: 18px; text-align: right;" - ), - br(), - br(), + br(), + p( "This ",tags$span("companion app", style = "color:#00B398"), " support the application of those calculations. + It allows to ", strong("map the necessary variables")," based on the xlsform definition of the dataset you have or will collect. + In case needs be, it eases ", strong("data recoding")," based on this mapping. Finally, it generates the indicators together with ", strong("standard report"),". + Though token identification, all of this can also be recorded in RIDL for data auditing and quality asurance" , + style = "font-size: 18px; text-align: left;"), + + br(), + p("This app is part of a ",tags$span("comprehensive app toolkit", style = "color:#00B398"), + " to mainstream knowledge & enhance the process of survey implementation through Kobotoolbox. It includes: ", + tags$a(href="https://rstudio.unhcr.org/rmsSampling/", "rmsSampling"), " to help designing sampling strategies, ", + tags$a(href="https://rstudio.unhcr.org/Survey_Designer", "SurveyDesigner"), " to help integrating annual survey needs, ", + tags$a(href="https://rstudio.unhcr.org/XlsFormUtil/", "XlsFormUtil"), " to help reviewing form contextualisation, ", + tags$a(href="https://rstudio.unhcr.org/HighFrequencyChecks/", "HighFrequencyChecks"), " to monitor data collection quality, ", + tags$a(href="https://rstudio.unhcr.org/kobocruncher/", "KoboCruncher"), " to perform rapid data exploration and compile indicators.", + style = "font-size: 12px; text-align: left;"), p(tags$i( class = "fa fa-github"), "App built with ", tags$a(href="https://edouard-legoupil.github.io/graveler/", diff --git a/R/mod_remap_code.R b/R/mod_remap_code.R new file mode 100644 index 0000000..50cd6f8 --- /dev/null +++ b/R/mod_remap_code.R @@ -0,0 +1,60 @@ +#' Module UI + +#' @title mod_remap_code_ui and mod_remap_code_server +#' @description A shiny module. +#' @description A shiny module. +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' @import shiny +#' @import shinydashboard +#' @keywords internal + +mod_remap_code_ui <- function(id) { + ns <- NS(id) + tabItem( + tabName = "remap_code", + fluidRow( + column( + width = 12, + h2('Variable Recoding'), + p("Review the non matching variables and code.") + ) + ), + + fluidRow( + shinydashboard::box( + title = "Module Step", + # status = "primary", + status = "info", + solidHeader = FALSE, + collapsible = TRUE, + width = 12, + "Content" +## do not forget that all elements ID of the GUI needs to be called with ns("ID").... + ) + + ) + ) +} + +#' Module Server +#' @noRd +#' @import shiny +#' @import tidyverse +#' @keywords internal + +mod_remap_code_server <- function(input, output, session, AppReactiveValue) { + ns <- session$ns +## add here the server logic part of your module.... +} + +## copy to body.R +# mod_remap_code_ui("remap_code_ui_1") + +## copy to sidebar.R +# shinydashboard::menuItem("displayName",tabName = "remap_code",icon = icon("user")) + +## and copy to app_server.R +# callModule(mod_remap_code_server, "remap_code_ui_1", AppReactiveValue) + diff --git a/R/mod_variable_mapping.R b/R/mod_variable_mapping.R new file mode 100644 index 0000000..dc5bd5e --- /dev/null +++ b/R/mod_variable_mapping.R @@ -0,0 +1,60 @@ +#' Module UI + +#' @title mod_variable_mapping_ui and mod_variable_mapping_server +#' @description A shiny module. +#' @description A shiny module. +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' @import shiny +#' @import shinydashboard +#' @keywords internal + +mod_variable_mapping_ui <- function(id) { + ns <- NS(id) + tabItem( + tabName = "variable_mapping", + fluidRow( + column( + width = 12, + h2('Variable mapping'), + p("The first step in the process is to map the variables defined in your specific XlsForm with the one expected for the calculation") + ) + ), + + fluidRow( + shinydashboard::box( + title = "Module Step", + # status = "primary", + status = "info", + solidHeader = FALSE, + collapsible = TRUE, + width = 12, + "Content" +## do not forget that all elements ID of the GUI needs to be called with ns("ID").... + ) + + ) + ) +} + +#' Module Server +#' @noRd +#' @import shiny +#' @import tidyverse +#' @keywords internal + +mod_variable_mapping_server <- function(input, output, session, AppReactiveValue) { + ns <- session$ns +## add here the server logic part of your module.... +} + +## copy to body.R +# mod_variable_mapping_ui("variable_mapping_ui_1") + +## copy to sidebar.R +# shinydashboard::menuItem("displayName",tabName = "variable_mapping",icon = icon("user")) + +## and copy to app_server.R +# callModule(mod_variable_mapping_server, "variable_mapping_ui_1", AppReactiveValue) + diff --git a/R/plot_rbm_sdg.R b/R/plot_rbm_sdg.R new file mode 100644 index 0000000..f830b16 --- /dev/null +++ b/R/plot_rbm_sdg.R @@ -0,0 +1,214 @@ +# WARNING - Generated by {fusen} from dev/utilities.Rmd: do not edit by hand + +#' @title Plot SDG Indicator for a country +#' @description The function is designed to help the interpretation of survey +#' results by providing a comparison guidelines. It displays a chart to have a +#' base of comparison when analyzing the results of UNHCR of UNHCR Result monitoring +#' survey. It pulls the values published within the UN Registry of SDG Indicator values +#' The function includes a mapping table between RBM/RMS and SDG and +#' extract the data from https://unstats.un.org/SDGAPI/swagger/ using the package SDGsR +#' https://drmattg.github.io/SDGsR/articles/Introduction_to_SDGsR.html +#' devtools::install_github("DrMattG/SDGsR", dependencies = TRUE) +#' @param country iso3 code for the country (easier to recall than the M49 used in the API) +#' @param rbm the RBM variable name - that can match SDG +#' @param years years to filter the chart - for instance c(2000,2022) +#' +#' @importFrom SDGsR get_indicator +#' @importFrom countrycode countrycode +#' @importFrom janitor clean_names +#' @importFrom stringr str_replace +#' +#' @return a ggplot2 object +#' @noRd +#' @examples +#' plot_rbm_sdg( country = "BRA", +#' rbm = "impact2_2", +#' years = c(2000, 2022)) + +#' unhcrthemes::theme_unhcr(font_size = 10) +plot_rbm_sdg <- function( country = "BRA", + rbm = "outcome16_2", + years = c(2000, 2022)) { + require(ggplot2) + require(dplyr) + + ## Below is a mapping table between indicators codes for UNHCR and SDG... +sdg_rbm <- structure(list( + indicator = c("1.4.1", "3.8.1", "16.9.1", "7.1.2", + "7.1.1", "3.1.2", "6.1.1", "6.2.1", + "8.10.2", "8.5.2", "1.4.2", "1.3.1", "16.1.4"), + + SDG_indic = c( + "1.4.1 Proportion of population living in households with access to basic services", + "3.8.1 Coverage of essential health services (defined as the average coverage of + essential services based on tracer interventions that include reproductive, maternal, + newborn and child health, infectious diseases, non-communicable diseases and service + capacity and access, among the general and the most disadvantaged population)", + "16.9.1 Proportion of children under 5 years of age whose births have been registered + with a civil authority, by age", + "7.1.2 Proportion of population with primary reliance on clean fuels and technology", + "7.1.1 Proportion of population with access to electricity", + "3.1.2 Proportion of births attended by skilled health personnel", + "6.1.1 Proportion of population using safely managed drinking water services", + "6.2.1 Proportion of population using (a) safely managed sanitation services and (b) + a hand-washing facility with soap and water", + "8.10.2 Proportion of adults (15 years and older) with an account at a bank or other + financial institution or with a mobile-money-service provider", + "8.5.2 Unemployment rate, by sex, age and persons with disabilities", + "1.4.2 Proportion of total adult population with secure tenure rights to land, (a) + with legally recognized documentation, and (b) who perceive their rights to land as + secure, by sex and type of tenure", + "1.3.1 Proportion of population covered by social protection floors/systems, by sex, + distinguishing children, unemployed persons, older persons, persons with disabilities, + pregnant women, newborns, work-injury victims and the poor and the vulnerable", + "16.1.4 Proportion of population that feel safe walking alone around the area they live"), + + RMS = c("impact2_2", "impact2_3", "outcome1_2", "outcome8_2", + "outcome9_2", "outcome10_2", "outcome12_1", "outcome12_2", "outcome13_1", + "outcome13_3", "outcome16_1", "outcome16_2", "impact3_3"), + + target = c("1.4", + "3.8", "16.9", "7.1", "7.1", "3.1", "6.1", "6.2", "8.10", "8.5", + "1.4", "1.3", "16.1"), + + description = c("By 2030, ensure that all men and women, in particular the poor and + the vulnerable, have equal rights to economic resources, as well as + access to basic services, ownership and control over land and other + forms of property, inheritance, natural resources, appropriate new + technology and financial services, including microfinance", + "Achieve universal health coverage, including financial risk protection, access to + quality essential health-care services and access to safe, effective, quality and + affordable essential medicines and vaccines for all", + "By 2030, provide legal identity for all, including birth registration", + "By 2030, ensure universal access to affordable, reliable and modern energy services", + "By 2030, ensure universal access to affordable, reliable and modern energy services", + "By 2030, reduce the global maternal mortality ratio to less than 70 per 100,000 live births", + "By 2030, achieve universal and equitable access to safe and affordable drinking water for all", + "By 2030, achieve access to adequate and equitable sanitation and hygiene for all and + end open defecation, paying special attention to the needs of women and girls and those + in vulnerable situations", "Strengthen the capacity of domestic financial institutions + to encourage and expand access to banking, insurance and financial services for all", + "By 2030, achieve full and productive employment and decent work for all women and men, + including for young people and persons with disabilities, and equal pay for work of equal value", + "By 2030, ensure that all men and women, in particular the poor and the vulnerable, + have equal rights to economic resources, as well as access to basic services, ownership + and control over land and other forms of property, inheritance, natural resources, + appropriate new technology and financial services, including microfinance", + "Implement nationally appropriate social protection systems and measures for all, + including floors, and by 2030 achieve substantial coverage of the poor and the vulnerable", + "Significantly reduce all forms of violence and related death rates everywhere")), + class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, + -13L)) + + # ctry <- ForcedDisplacementStat::reference |> + # filter(iso_3 == country ) |> + # select(iso_3, ctryname, M49_code) + + sdg_code_label <- sdg_rbm |> + filter(RMS == rbm ) + + sdg_code <- sdg_rbm |> + filter(RMS == rbm ) |> + pull(indicator) + + #cat(paste0("\n \n -------\n Pulling RMS Host country comparison data for ", ctry$ctryname, "\n\n")) + #cat(paste0("Retrieving now : ", sdg_code_label$SDG_indic , "\n")) + Ind1 <- SDGsR::get_indicator(Country = countrycode::countrycode(country, + origin = 'iso3c', + destination = 'un'), + indicator= sdg_code) + + ## Check if the API did return something + if(nrow(Ind1) == 0) { + #cat(paste0("\n ಠ_ಠ \n No data rcould be etrieved from API for ", sdg_code_label$SDG_indic , " in country: ", ctry$ctryname ,"n\n")) + p <- ggplot() + + annotate("text", x = 1, y = 1, size = 10, + label = stringr::str_wrap(paste0("\n ಠ_ಠ \n No data could be retrieved from UNStat API for: ", + sdg_code_label$SDG_indic , " (related to UNHCR Indicator ", rbm , + ") in country: ", + countrycode::countrycode(country, + origin = 'iso3c', + destination = 'country.name') , + "."), 50 ) ) + theme_void() + + + return(p) + } else { + # cat(paste0("Done! ", nrow(Ind1), " records gathered ヽ(´▽`)/ \n\n")) + + ## Remove rows when value is NaN + Ind1 <- Ind1[ !(is.nan(Ind1$value)), ] + ## Replace NaN by NA for upper and lower Bound + Ind1$upperBound <- ifelse(is.nan(Ind1$upperBound), NA , Ind1$upperBound ) + Ind1$lowerBound <- ifelse(is.nan(Ind1$lowerBound), NA , Ind1$lowerBound ) + + #cat ("sleep 3 sec between each indicators...") + #Sys.sleep(3) + + + #Ind1$target <- as.character(Ind1$target ) + Ind1 <- Ind1 %>% + as.data.frame() %>% + janitor::clean_names() %>% + ## Cleaning a few country name for better legibility + dplyr::mutate ( geo_area_name = stringr::str_replace(geo_area_name, "Venezuela \\(Bolivarian Republic of\\)", "Venezuela"), + geo_area_name = stringr::str_replace(geo_area_name, "Bolivia \\(Plurinational State of\\)", "Bolivia")) #%>% + #dplyr::left_join(Goals, by="target") + #names(Ind1) + + ## remove all empty disaggregation + # Ind2 <- as.data.frame(Ind1[ , colSums(is.na(Ind1)) == 0]) + Ind2 <- Ind1%>% + select(series_description, geo_area_name, time_period_start,value ) %>% + group_by(series_description, geo_area_name, time_period_start) %>% + ## Aggregate base on Unit type - aka sum or average + summarize(valmean = mean(as.numeric(value)), + valsum = sum(as.numeric(value)) )%>% + #So we overprint in the right order + arrange(time_period_start) #%>% + + if( unique(Ind1$attributes$Units) %in% c("NUM_TH" , "NUMBER") ) { + Ind2$value <- Ind2$valsum + } else { + Ind2$value <- Ind2$valmean + } + # names(Ind2) + p <- ggplot(data = Ind2, + aes(x = time_period_start, + y = value, + group = 1)) + + geom_line( linewidth = 1.5, color = "#0072BC" ) + + geom_point(shape =15, size = 2, color = "#0072BC") + + facet_wrap(~ series_description) + + #scale_y_continuous(labels = unhcRstyle::format_si()) + + scale_x_continuous(limits = years) + + #geom_hline(yintercept = 0, size = 0.7, colour = "#333333") + + unhcrthemes::theme_unhcr(font_size = 20) + ## Insert UNHCR Style + theme(panel.grid.major.y = element_line(color = "#cbcbcb"), + panel.grid.major.x = element_blank(), + panel.grid.minor = element_blank(), + #panel.grid.major.x = element_blank(), + legend.position="none", + strip.text.x = element_text(size = 8)) + + labs(title = stringr::str_wrap(paste0( countrycode::countrycode(country, + origin = 'iso3c', + destination = 'country.name'), ": ",sdg_code_label$description ), 80), + subtitle = stringr::str_wrap( paste0(sdg_code_label$SDG_indic, " (related to UNHCR Indicator ", rbm, ")"), 100), + x = " ", + y = paste0(unique(Ind1$attributes$Units)), + caption = stringr::str_wrap( paste0("Source: ", unique(Ind1$source), ", Data extracted from UNStat API"), 100)) + + # gghighlight::gghighlight(value >= mean(dfna1$value), + # #value - sdval, + # use_direct_label = FALSE) + + # geom_tile( data = yearfocus, + # aes(x = year, + # y = value, + # fill = as_factor((decade/10)%%2)), + # show.legend = FALSE) + + # scale_fill_manual(values = c("0" = "white", + # "1" = "#99999922")) + + return(p) + + } + +} diff --git a/R/sidebar.R b/R/sidebar.R index 8bd36c5..88430fe 100755 --- a/R/sidebar.R +++ b/R/sidebar.R @@ -11,7 +11,10 @@ sidebar <- function() { shinydashboard::dashboardSidebar( shinydashboard::sidebarMenu( ## Here the menu item entry to the first module - shinydashboard::menuItem("About",tabName = "home",icon = icon("bookmark")) + shinydashboard::menuItem("About",tabName = "home",icon = icon("bookmark")), + shinydashboard::menuItem("Map Variable",tabName = "variable_mapping",icon = icon("map-location")), + shinydashboard::menuItem("Recode Data",tabName = "remap_code",icon = icon("code")), + shinydashboard::menuItem("Apply calculations",tabName = "apply_calculation",icon = icon("calculator")) # - add more - separated by a comma! ## For icon search on https://fontawesome.com/search?o=r&m=free - filter on free ) diff --git a/R/var_dummy.R b/R/var_dummy.R new file mode 100644 index 0000000..6a8df3d --- /dev/null +++ b/R/var_dummy.R @@ -0,0 +1,182 @@ +# WARNING - Generated by {fusen} from dev/utilities.Rmd: do not edit by hand + +#' var_dummy +#' +#' Append to an existing dataframe new Generate the variable based on 1. type, 2. constraint and 3.relevance +#' +#' @param frame dataframe object where new dummy varaible will be created... +#' @param name name of the variable to be created +#' @param type type of the variable to be created in line with xlsform - +#' one of the following 6 options: +#' "select_one", "select_multiple", "text", "integer", "numeric", "date" +#' +#' "start ", "end", "calculate", "geopoint","acknowledge", +#' "begin_group", "end_group", "begin_repeat", "end_repeat" , "note" +#' +#' @param list_opt a vector with all possible values for select_one and select_multiple +#' - can be null +#' @param constraint specific constraint - used for for numeric or integer +## @param seed random seed +#' +#' @return dataframe +#' +#' @importFrom withr with_seed +#' @importFrom dplyr mutate n tibble rename +#' @importFrom stats rlnorm +#' @importFrom tidyr unnest +#' +#' @noRd +#' +#' @export +#' @examples +#' +#' ## let's initiate a dataframe with an index of n r records +#' n <- 384 +#' frame <- dplyr::tibble( +#' index = paste0( "ID-", +#' purrr::as_vector( +#' purrr::map(n, sample(LETTERS, 4)) |> +#' purrr::map(paste0, collapse = "")), +#' "-", +#' formatC(1:n, width = nchar(n) + 1, flag = "0") +#' )) +#' +#' ## test inject select_one +#' frame <- var_dummy( +#' frame = frame, +#' name = "testselect_one", +#' type = "select_one", +#' list_opt = c("alpha", "beta", "delta"), +#' constraint = NULL +#' ) +#' ## test inject select_multiple in main +#' frame <- var_dummy( +#' frame = frame, +#' name = "testselect_multiple", +#' type = "select_multiple", +#' list_opt = c("alpha", "beta", "delta"), +#' constraint = NULL +#' ) +#' +#' ## test inject text +#' frame <- var_dummy( +#' frame = frame, +#' name = "testtext", +#' type = "text", +#' list_opt = NULL, +#' constraint = NULL +#' ) +#' +#' +#' ## test inject numeric +#' frame <- var_dummy( +#' frame = frame, +#' name = "testnumeric", +#' type = "numeric", +#' list_opt = NULL, +#' constraint = NULL +#' ) +#' +#' ## test inject date +#' frame <- var_dummy( +#' frame = frame, +#' name = "testdate", +#' type = "date", +#' list_opt = NULL, +#' constraint = NULL +#' ) +#' +#' ## Preview out out +#' knitr::kable(head(frame, 5)) +var_dummy <- function( frame, + name, + type, + list_opt, + constraint #, + # seed = 1976 + ) { + ## number of records to be generated depends on the initial frame.. + n <- nrow(frame) + #withr::with_seed(seed = seed) + # withr::with_seed( + # seed = seed, + # suppressWarnings( + + # no content ########### + if( type %in% c("begin_group", "end_group", "begin_repeat", "end_repeat" , "note" )) { + res <- dplyr::tibble( + thisvar = NA) + names(res)[1] <- name + frame <- cbind(frame,res) + } + + + ## acknowledge ########### + if( type %in% c("acknowledge")) { + res <- dplyr::tibble( + thisvar = sample(c(0,1), n, replace = TRUE)) + names(res)[1] <- name + frame <- cbind(frame,res) + } + + + ## select one ########### + if( type %in% c("select_one") ) { + res <- dplyr::tibble( thisvar = sample(c(list_opt), n, replace = TRUE) ) + ## Now rename the variable + names(res)[1] <- name + frame <- cbind(frame,res) + } + + ## select multiple ########### + if( type %in% c("select_multiple")) { + for (modality in list_opt) { + res <- dplyr::tibble( + thisvar = sample(c(0,1), n, replace = TRUE)) + names(res)[1] <- paste0(name, "_",modality ) + frame <- cbind(frame,res) + } + } + + ## stext ########### + if( type %in% c("text")) { + res <- dplyr::tibble( + thisvar = paste0( "FreeText_", + purrr::as_vector( + purrr::map(n, sample(LETTERS, 6)) |> + purrr::map(paste0, collapse = "")), + "-", + formatC(1:n, width = nchar(n) + 1, flag = "0") + )) + ## Now rename the variable + names(res)[1] <- name + frame <- cbind(frame,res) + } + + ## numeric ########### + if( type %in% c("numeric", "integer", "calculate", "geopoint")) { + ## TODO extract elements from constraint to define num1 an num2 + num1 <- 18 + num2 <- 95 + + res <- dplyr::tibble( + thisvar = sample(num1:num2, n, replace = TRUE)) + ## Now rename the variable + names(res)[1] <- name + frame <- cbind(frame,res) + } + + ## date ########### + if( type %in% c("date", "start ", "end")) { + res <- dplyr::tibble( + thisvar = Sys.time() - abs(rnorm(n, 0, sd = 2) * 365 * 24 * 3600)) + ## Now rename the variable + names(res)[1] <- name + frame <- cbind(frame,res) + } + + # ) + # ) + + return(frame) +} diff --git a/README.Rmd b/README.Rmd index be03d6f..a577af1 100644 --- a/README.Rmd +++ b/README.Rmd @@ -28,14 +28,18 @@ Each calculation is implemented as a function with in-built check to identify wh - -*Population* refers to survey population in this guidance for the calculation of indicators as shown by enumerator and denominator. -*Denominators* that are representing the households will be obtained by weighting the number of households by the number of household members at the end of the analysis. If there are no weights used it will be used as 'weight' variable for household level indicators. - ## Usage The easiest way to use the package is through the [shiny interface](http://rstudio.unhcr.org/IndicatorCalc) and then follow the instruction from there. + The workflow is described below: + + 1. Run the function var_mapping( "path/to/myxlsform.xlsx") in order to create your __variable mapping__. The variable mapping is designed to check if the expected variables and modalities are present in your dataset. + + 2. Review manually the variable mapping and __recode data_ manually the variables where the automatic match could not be applied and upload it back + + 3. Then either generate a dummy dataset or connect your project with [RIDL](https://ridl.unhcr.org) and __apply calculation__ to get you summary report and download your expanded XlsForm to include it within your [Kobocruncher automatic data exploration](https/rstudio.unhcr.org/kobcruncher) + ## Developpers diff --git a/dev/01_dev.R b/dev/01_dev.R index ddfa33f..92c7cad 100755 --- a/dev/01_dev.R +++ b/dev/01_dev.R @@ -47,8 +47,9 @@ golem::run_dev() ## Now start adding modules from console # Modules are like the pipe between your back-office functions and your user # Name of the module - "my_first_module" -# graveler::level_up(name = "my_first_module") - +# graveler::level_up(name = "variable_mapping") +# graveler::level_up(name = "remap_code") +# graveler::level_up(name = "apply_calculation") ### Deploy the app ---------- diff --git a/dev/config_fusen.yaml b/dev/config_fusen.yaml index 9ebdb47..4327313 100644 --- a/dev/config_fusen.yaml +++ b/dev/config_fusen.yaml @@ -29,3 +29,22 @@ indicators.Rmd: check: true document: true overwrite: ask +utilities.Rmd: + path: dev/utilities.Rmd + state: active + R: + - R/kobo_dummy.R + - R/plot_rbm_sdg.R + - R/var_dummy.R + tests: + - tests/testthat/test-var_dummy.R + - tests/testthat/test-kobo_dummy.R + - tests/testthat/test-plot_rbm_sdg.R + vignettes: vignettes/utilities.Rmd + inflate: + flat_file: dev/utilities.Rmd + vignette_name: Utilities + open_vignette: true + check: true + document: true + overwrite: ask diff --git a/dev/indicators.Rmd b/dev/indicators.Rmd index c19ad56..1573f30 100644 --- a/dev/indicators.Rmd +++ b/dev/indicators.Rmd @@ -43,13 +43,18 @@ Therefore each indicator function is organised in 3 steps: * If not apply the mapping supplied as argument within the function `fct_re_map` * Apply the calculation - either to append the new variable to the existing data or to output just the final vector with results. - + + + ## fct_check_map ```{r function-fct_check_map} #' fct_check_map #' -#' This check is the standard variable and modalities +#' This check if the standard variables and modalities included in the mapper are +#' actually present in the datalist with the same exact name - this is actually +#' usually not the case as the standard format to save kobodatset in xlsx includes +#' group in the variable name #' #' @param datalist A list with all hierarchical data frame for a survey data set. #' format is expected to match the Excel export synchronized from kobo to RILD @@ -69,7 +74,9 @@ fct_check_map <- function(datalist, mapper){ for ( i in 1:nrow(mapper[["variablemap"]]) ) { # i <- 1 thisvar <- mapper[["variablemap"]][["variable"]][[i]] - if ( is.null(datalist[[mapper[["hierarchy"]] ]] [[ thisvar ]]) ) + + if ( is.null( datalist[[mapper[["hierarchy"]] ]] [[ thisvar ]] ) ) + {cli::cli_alert_info(paste0( thisvar ," standard variable was not found in the dataset.\n")) } else { @@ -172,9 +179,9 @@ fct_get_all_variable_names <- function(datalist){ ``` ```{r example-fct_get_all_variable_names} -data <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) -varname <- fct_get_all_variable_names(datalist = data) +varname <- fct_get_all_variable_names(datalist = datalist) head(varname, 10) ``` @@ -183,6 +190,7 @@ test_that("fct_get_all_variable_names works", { expect_true(inherits(fct_get_all_variable_names, "function")) }) ``` + ## fct_re_map @@ -314,12 +322,12 @@ test_that("fct_re_map works", { #' Wrapper for a summary chart for indicator - allows to add hint, source, icon #' and interpretation threshold if available #' -#' @params indicator vector -#' @params subtitle_chart -#' @params caption_chart -#' @params ordered_threhold vector with the different threshold +#' @param indicator vector +#' @param subtitle_chart +#' @param caption_chart +#' @param ordered_threhold vector with the different threshold #' (green, orange, red) -#' @params iconunicode unicode value for fontawesome --- +#' @param iconunicode unicode value for fontawesome --- #' see https://fontawesome.com/search?o=r&m=free #' #' @@ -495,7 +503,7 @@ inter_electricity <- function(datalist, ``` ```{r example-inter_electricity} -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) mapper <- list( hierarchy = "main", @@ -1020,7 +1028,7 @@ return(datalist) ``` ```{r example-inter_shelter} -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) mapper <- list( @@ -1178,7 +1186,8 @@ return(datalist) ``` ```{r example-impact_2_2} -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file(#"demo_data.xlsx", + "test.xlsx", package = "IndicatorCalc")) #Healthcare @@ -1228,9 +1237,9 @@ datalist <- inter_electricity( datalist =datalist, mapper = mapper ) ## in the contextualised form - DWA03a has been skipped and all results are in min... ## only manual transformation can adjust this before we use the mapper.. -datalist[["main"]]$DWA03a <- "1" +datalist[["main"]]$DWA03a <- "1" -datalist[["main"]]$DWA03b <- +datalist[["main"]]$DWA03b <- datalist[["main"]]$VulnerabilityScoring.BasicNeeds.DWA03 # now the mapper @@ -1426,18 +1435,65 @@ impact2_3 <- function(datalist, label = c( "In the past 3 months, did ${name_individual} need to see a health professional for any reason?", "In the past 3 months, did you receive medical care when needed for the reason above?", - "Why have you been unable to access a medical care in the past 3 months?"), + "Why have you been unable to access a medical care in the past 3 months? - 1 Health facility too far", + "Why have you been unable to access a medical care in the past 3 months? - 2 Medicine or health facility too expensive", + "Why have you been unable to access a medical care in the past 3 months? - 3 No treatment exists/ Not necessary", + "Why have you been unable to access a medical care in the past 3 months? - 4 Don't know where to go", + "Why have you been unable to access a medical care in the past 3 months? - 5 No time +6 Prefer other options", + "Why have you been unable to access a medical care in the past 3 months? - 7 Health facility does not accept new patients", + "Why have you been unable to access a medical care in the past 3 months? - 8 Don't trust modern medicine", + "Why have you been unable to access a medical care in the past 3 months? - 9 Don't trust doctors", + "Why have you been unable to access a medical care in the past 3 months? - 10 Administrative/documentation issues (certificates, service cards etc.)", + "Why have you been unable to access a medical care in the past 3 months? - 96 Other (Specify) " + + ), variable = c("HACC01", "HACC03", - "HACC04"), + "HACC04_1", + "HACC04_2", + "HACC04_3", + "HACC04_4", + "HACC04_5", + "HACC04_6", + "HACC04_7", + "HACC04_8", + "HACC04_9", + "HACC04_10", + "HACC04_96"), mappattern = c("HACC01", - "HACC03", - "HACC04") ), + "HACC03", + "HACC04_1", + "HACC04_2", + "HACC04_3", + "HACC04_4", + "HACC04_5", + "HACC04_6", + "HACC04_7", + "HACC04_8", + "HACC04_9", + "HACC04_10", + "HACC04_96") ), modalitymap = data.frame( - variable = c( "HACC01", "HACC03" ), - label = c( "yes", "yes"), - standard = c( "1","1" ), - map = c("1","1" ))) ){ + variable = c( "HACC01", "HACC03" , + "HACC04_1", + "HACC04_2", + "HACC04_3", + "HACC04_4", + "HACC04_5", + "HACC04_6", + "HACC04_7", + "HACC04_8", + "HACC04_9", + "HACC04_10", + "HACC04_96"), + label = c( "yes", "yes", + "yes", "yes", "yes", "yes", "yes", "yes", "yes", + "yes", "yes", "yes", "yes"), + standard = c( "1","1" , + "1","1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1","1" ), + map = c("1","1" , + "1","1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1","1" ))) ){ ## So first we check that we have what we need in the data set based on the mapper check_map <- fct_check_map(datalist = datalist, @@ -1446,23 +1502,24 @@ impact2_3 <- function(datalist, mapper = mapper) -datalist[["ind"]]$health_NOacc<- dplyr::case_when( - datalist[["ind"]]$HACC03=="1" & - (datalist[["ind"]]$HACC04_7=="1" | - datalist[["ind"]]$HACC04_8=="1" | - datalist[["ind"]]$HACC04_96=="1" ) ~ "0", +datalist[["ind"]]$health_NOacc <- dplyr::case_when( + datalist[["ind"]]$HACC03 == "1" & + (datalist[["ind"]]$HACC04_7 == "1" | + datalist[["ind"]]$HACC04_8 == "1" | + datalist[["ind"]]$HACC04_96 == "1" ) ~ "0", - datalist[["ind"]]$HACC03=="1" & - (datalist[["ind"]]$HACC04_1=="1" | - datalist[["ind"]]$HACC04_2=="1" | - datalist[["ind"]]$HACC04_3=="1" | - datalist[["ind"]]$HACC04_4=="1" | - datalist[["ind"]]$HACC04_5=="1" | - datalist[["ind"]]$HACC04_6=="1" | - datalist[["ind"]]$HACC04_9=="1" | - datalist[["ind"]]$HACC04_10=="1") ~ "1", + datalist[["ind"]]$HACC03 == "1" & + (datalist[["ind"]]$HACC04_1 == "1" | + datalist[["ind"]]$HACC04_2 == "1" | + datalist[["ind"]]$HACC04_3 == "1" | + datalist[["ind"]]$HACC04_4 == "1" | + datalist[["ind"]]$HACC04_5 == "1" | + datalist[["ind"]]$HACC04_6 == "1" | + datalist[["ind"]]$HACC04_9 == "1" | + datalist[["ind"]]$HACC04_10 == "1") ~ "1", TRUE ~ "0") +# table(datalist[["ind"]]$health_NOacc, useNA = "ifany") datalist[["ind"]]$health_NOacc <- as.numeric(datalist[["ind"]]$health_NOacc) datalist[["ind"]]$HACC01 <- as.numeric(datalist[["ind"]]$HACC01) @@ -1488,28 +1545,73 @@ datalist[["ind"]]$impact2_3 <- labelled::labelled( datalist[["ind"]]$impact2_3, ```{r example-impact2_3} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mpper -mapper <- list( +mapper <- list( hierarchy = "ind", variablemap = data.frame( label = c( "In the past 3 months, did ${name_individual} need to see a health professional for any reason?", "In the past 3 months, did you receive medical care when needed for the reason above?", - "Why have you been unable to access a medical care in the past 3 months?"), + "Why have you been unable to access a medical care in the past 3 months? - 1 Health facility too far", + "Why have you been unable to access a medical care in the past 3 months? - 2 Medicine or health facility too expensive", + "Why have you been unable to access a medical care in the past 3 months? - 3 No treatment exists/ Not necessary", + "Why have you been unable to access a medical care in the past 3 months? - 4 Don't know where to go", + "Why have you been unable to access a medical care in the past 3 months? - 5 No time +6 Prefer other options", + "Why have you been unable to access a medical care in the past 3 months? - 7 Health facility does not accept new patients", + "Why have you been unable to access a medical care in the past 3 months? - 8 Don't trust modern medicine", + "Why have you been unable to access a medical care in the past 3 months? - 9 Don't trust doctors", + "Why have you been unable to access a medical care in the past 3 months? - 10 Administrative/documentation issues (certificates, service cards etc.)", + "Why have you been unable to access a medical care in the past 3 months? - 96 Other (Specify) " ), variable = c("HACC01", "HACC03", - "HACC04"), + "HACC04_1", + "HACC04_2", + "HACC04_3", + "HACC04_4", + "HACC04_5", + "HACC04_6", + "HACC04_7", + "HACC04_8", + "HACC04_9", + "HACC04_10", + "HACC04_96"), mappattern = c("HACC01", - "HACC03", - "HACC04") ), + "HACC03", + "HACC04_1", + "HACC04_2", + "HACC04_3", + "HACC04_4", + "HACC04_5", + "HACC04_6", + "HACC04_7", + "HACC04_8", + "HACC04_9", + "HACC04_10", + "HACC04_96") ), modalitymap = data.frame( - variable = c( "HACC01", "HACC03" ), - label = c( "yes", "yes"), - standard = c( "1","1" ), - map = c("1","1" ))) + variable = c( "HACC01", "HACC03" , + "HACC04_1", + "HACC04_2", + "HACC04_3", + "HACC04_4", + "HACC04_5", + "HACC04_6", + "HACC04_7", + "HACC04_8", + "HACC04_9", + "HACC04_10", + "HACC04_96"), + label = c( "yes", "yes", + "yes", "yes", "yes", "yes", "yes", "yes", "yes", + "yes", "yes", "yes", "yes"), + standard = c( "1","1" , + "1","1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1","1" ), + map = c("1","1" , + "1","1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1" ,"1","1" ))) ## Apply indicator function on datalist datalist <- impact2_3(datalist, mapper ) @@ -1645,7 +1747,7 @@ datalist[["ind"]]$impact3_2a <- labelled::labelled(datalist[["ind"]]$impact3_2a ```{r example-impact3_2a} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mpper @@ -1786,7 +1888,7 @@ datalist[["ind"]]$impact3_2b <- labelled::labelled(datalist[["ind"]]$impact3_2b ```{r example-impact3_2b} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mpper mapper <- list("") @@ -1897,7 +1999,7 @@ datalist[["main"]]$impact3_3 <- labelled::labelled(datalist[["main"]]$impact3_3 ```{r example-impact3_3} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mpper @@ -2057,7 +2159,7 @@ datalist[["ind"]]$outcome1_2 <- labelled::labelled(datalist[["ind"]]$outcome1_2 ```{r example-outcome1_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -2238,7 +2340,7 @@ datalist[["ind"]]$outcome1_3 <- labelled::labelled(datalist[["ind"]]$outcome1_3 ```{r example-outcome1_3} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -2358,7 +2460,7 @@ datalist[["main"]]$outcome4_1 <- labelled::labelled(datalist[["main"]]$outcome4 ```{r example-outcome4_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -2497,7 +2599,7 @@ datalist[["main"]]$outcome4_2 <- labelled::labelled(datalist[["main"]]$outcome4 ```{r example-outcome4_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -2613,7 +2715,7 @@ datalist[["ind"]]$outcome5_2 <- labelled::labelled(datalist[["ind"]]$outcome5_2 ```{r example-outcome5_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -2729,7 +2831,7 @@ datalist[["main"]]$outcome8_2 <- labelled::labelled(datalist[["main"]]$outcome8 ```{r example-outcome8_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -2940,7 +3042,7 @@ datalist[["main"]]$outcome9_1 <- labelled::labelled(datalist[["main"]]$outcome9 ```{r example-outcome9_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3057,7 +3159,7 @@ datalist[["main"]]$outcome9_2 <- labelled::labelled(datalist[["main"]]$outcome9 ```{r example-outcome9_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3168,7 +3270,7 @@ datalist[["ind"]]$outcome10_1 <- labelled::labelled(datalist[["ind"]]$outcome10 ```{r example-outcome10_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3292,7 +3394,7 @@ datalist[["main"]]$outcome10_2 <- labelled::labelled(datalist[["main"]]$outcome ```{r example-outcome10_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3456,7 +3558,7 @@ datalist[["main"]]$outcome12_1 <- labelled::labelled(outcome12_1 , ```{r example-outcome12_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3611,7 +3713,7 @@ datalist[["main"]]$outcome12_2 <- labelled::labelled(datalist[["main"]]$outcome ```{r example-outcome12_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3724,7 +3826,7 @@ datalist[["main"]]$outcome13_1 <- labelled::labelled(datalist[["main"]]$outcome ```{r example-outcome13_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3832,7 +3934,7 @@ datalist[["main"]]$outcome13_2 <- labelled::labelled(datalist[["main"]]$outcome ```{r example-outcome13_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -3970,7 +4072,7 @@ datalist[["main"]]$outcome13_3 <- ```{r example-outcome13_3} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -4072,13 +4174,13 @@ datalist[["ind"]]$document_under5 <- dplyr::case_when( datalist[["ind"]]$REG03 == 1 #add birth certificate as additional document from REG03 ~ 1, datalist[["ind"]]$REG05a == 0 & - datalist[["ind"]]$REG05b== 0 & - datalist[["ind"]]$REG05c== 0 & - datalist[["ind"]]$REG05d== 0 & - datalist[["ind"]]$REG05e== 0 & - datalist[["ind"]]$REG05f== 0 & - datalist[["ind"]]$REG06== 0 & - datalist[["ind"]]$REG03== 0 ~ 0, + datalist[["ind"]]$REG05b == 0 & + datalist[["ind"]]$REG05c == 0 & + datalist[["ind"]]$REG05d == 0 & + datalist[["ind"]]$REG05e == 0 & + datalist[["ind"]]$REG05f == 0 & + datalist[["ind"]]$REG06 == 0 & + datalist[["ind"]]$REG03 == 0 ~ 0, TRUE ~ NA_real_ ) ###Calculate valid identity documents for above 5 with REG01 and REG02 variables @@ -4133,7 +4235,7 @@ datalist[["ind"]]$outcome14_1 <- labelled::labelled(datalist[["ind"]]$outcome14 ```{r example-outcome14_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -4274,7 +4376,7 @@ datalist[["main"]]$utcome16_1 <- labelled::labelled(datalist[["main"]]$outcome1 ```{r example-outcome16_1} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper @@ -4388,7 +4490,7 @@ datalist[["main"]]$outcome16_2 <- labelled::labelled(datalist[["main"]]$outcome ```{r example-outcome16_2} ## data -datalist <- kobocruncher::kobo_data( system.file("test.xlsx", +datalist <- kobocruncher::kobo_data( system.file("demo_data.xlsx", #"test.xlsx", package = "IndicatorCalc")) ## mapper diff --git a/dev/utilities.Rmd b/dev/utilities.Rmd index 2917920..82abe03 100644 --- a/dev/utilities.Rmd +++ b/dev/utilities.Rmd @@ -37,7 +37,7 @@ pkgload::load_all(path = here::here(), export_all = FALSE) ``` -# Generating data from form +# Generating data from a specific form definition One key function is to generate a dummy dataset based on a specific form structure @@ -261,8 +261,7 @@ test_that("var_dummy works", { #' (Some advanced functionality such as "coalesce()" not covered) #' - respects "`constraint`" #' - respects "`repeat`" adds ID column to link hierarchical data based on "`repeat_count`" - -#' @reference the function is a rewriting of +#' This function is a rewriting of #' https://unhcr.github.io/koboloadeR/docs/reference/kobo_dummy.html #' it also build on https://thinkr-open.github.io/fakir/ and #' https://docs.ropensci.org/charlatan/ @@ -323,6 +322,7 @@ kobo_dummy <- function(form, "-", formatC(1:n, width = nchar(n) + 1, flag = "0") )) + names(main)[1] <- "_index" ## then apply var_dummy interactively... for(i in (1:nrow(conf)) ) { @@ -421,6 +421,10 @@ kobo_dummy <- function(form, formatC(1:n, width = nchar(n) + 1, flag = "0") )) + names(repframe)[1] <- "_parent_index" + ## Apply now `_index` + ## TODO -- check if we have a `repeat_count` to apply limitation.. + ## then apply var_dummy interactively... for(i in (1:nrow(confrep)) ) { # i <- 6 @@ -448,7 +452,6 @@ kobo_dummy <- function(form, constraint = this.constraint ) } - ## TODO -- check if we have a `repeat_count` to apply limitation.. ## append to the repeat datalist[[rep]] <- repframe @@ -466,6 +469,10 @@ form <- system.file("RMSCAPI.xlsx", package = "IndicatorCalc") datalist <- kobo_dummy(form, n = 384, file = NULL) + +## Save this to use it for testing the package... + +openxlsx::write.xlsx(datalist, here::here("inst", "demo_data.xlsx")) ``` ```{r tests-kobo_dummy} @@ -492,7 +499,7 @@ test_that("kobo_dummy works", { #' @param years years to filter the chart - for instance c(2000,2022) #' #' @importFrom SDGsR get_indicator -#' @importFrom ForcedDisplacementStat reference +#' @importFrom countrycode countrycode #' @importFrom janitor clean_names #' @importFrom stringr str_replace #' @@ -571,9 +578,9 @@ sdg_rbm <- structure(list( class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -13L)) - ctry <- ForcedDisplacementStat::reference |> - filter(iso_3 == country ) |> - select(iso_3, ctryname, M49_code) + # ctry <- ForcedDisplacementStat::reference |> + # filter(iso_3 == country ) |> + # select(iso_3, ctryname, M49_code) sdg_code_label <- sdg_rbm |> filter(RMS == rbm ) @@ -584,7 +591,10 @@ sdg_rbm <- structure(list( #cat(paste0("\n \n -------\n Pulling RMS Host country comparison data for ", ctry$ctryname, "\n\n")) #cat(paste0("Retrieving now : ", sdg_code_label$SDG_indic , "\n")) - Ind1 <- SDGsR::get_indicator(Country= ctry$M49_code, indicator= sdg_code) + Ind1 <- SDGsR::get_indicator(Country = countrycode::countrycode(country, + origin = 'iso3c', + destination = 'un'), + indicator= sdg_code) ## Check if the API did return something if(nrow(Ind1) == 0) { @@ -594,7 +604,10 @@ sdg_rbm <- structure(list( label = stringr::str_wrap(paste0("\n ಠ_ಠ \n No data could be retrieved from UNStat API for: ", sdg_code_label$SDG_indic , " (related to UNHCR Indicator ", rbm , ") in country: ", - ctry$ctryname ,"."), 50 ) ) + theme_void() + countrycode::countrycode(country, + origin = 'iso3c', + destination = 'country.name') , + "."), 50 ) ) + theme_void() return(p) @@ -655,7 +668,9 @@ sdg_rbm <- structure(list( #panel.grid.major.x = element_blank(), legend.position="none", strip.text.x = element_text(size = 8)) + - labs(title = stringr::str_wrap(paste0( ctry$ctryname, ": ",sdg_code_label$description ), 80), + labs(title = stringr::str_wrap(paste0( countrycode::countrycode(country, + origin = 'iso3c', + destination = 'country.name'), ": ",sdg_code_label$description ), 80), subtitle = stringr::str_wrap( paste0(sdg_code_label$SDG_indic, " (related to UNHCR Indicator ", rbm, ")"), 100), x = " ", y = paste0(unique(Ind1$attributes$Units)), @@ -701,7 +716,7 @@ test_that("plot_rbm_sdg works", { ```{r development-inflate, eval=FALSE} # Keep eval=FALSE to avoid infinite loop in case you hit the knit button # Execute in the console directly -fusen::inflate(flat_file = "dev/flat_full.Rmd", vignette_name = "Get started") +fusen::inflate(flat_file = "dev/utilities.Rmd", vignette_name = "Utilities") ```