diff --git a/DESCRIPTION b/DESCRIPTION index ec5b395..75c7d38 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,15 +20,22 @@ Imports: ggforce, ggplot2, ggtext, + glue, golem, + here, + httr, janitor, kobocruncher, labelled, + openxlsx, plyr, purrr, + riddle, + rmarkdown, SDGsR, shiny, shinydashboard, + shinyWidgets, showtext, sjlabelled, sjmisc, @@ -38,12 +45,14 @@ Imports: systemfonts, tibble, tidyr, + tidyverse, + unhcrdatapackage, unhcrshiny, unhcrthemes, + utils, withr Suggests: knitr, - rmarkdown, testthat VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 7a7fccd..d4f67ea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(compass_table) export(fct_check_map) export(fct_get_all_variable_names) export(fct_plot_indic_donut) @@ -49,6 +50,7 @@ importFrom(stringr,str_replace) importFrom(tibble,as_tibble_col) importFrom(tibble,tibble) importFrom(tidyr,unnest) +importFrom(unhcrdatapackage,end_year_population_totals_long) importFrom(unhcrshiny,theme_shinydashboard_unhcr) importFrom(unhcrthemes,scale_fill_unhcr_d) importFrom(unhcrthemes,theme_unhcr) diff --git a/R/body.R b/R/body.R index 66902f3..5abe01b 100755 --- a/R/body.R +++ b/R/body.R @@ -11,6 +11,7 @@ body <- function() { shinydashboard::dashboardBody( unhcrshiny::theme_shinydashboard_unhcr(), + golem::activate_js(), tags$head( tags$script(src = "custom.js") ), diff --git a/R/compass_table.R b/R/compass_table.R new file mode 100644 index 0000000..ac97cb3 --- /dev/null +++ b/R/compass_table.R @@ -0,0 +1,212 @@ +# WARNING - Generated by {fusen} from dev/utilities.Rmd: do not edit by hand + +#' @title Write simple compass indicator table +#' @description The function take the list of calculated variables from an RMS +#' and output an excel document in the same folder with the correct +#' format for import into COMPASS. +#' +#' The function assumes you have already calculated the indicators and +#' have a datalist object with all the correct calculation inside +#' +#' @param country iso3 code for the country (easier to recall than the M49 used in the API) +#' @param operation operation name +#' @param year year to use to extract the baseline from Population Statistics +#' @param population_type The list of population type for baseline calculation +#' @param population_rms The list of population type covered by RMS +#' @param rms_indicator list with indicators and their related frame to pull the value +#' @param ridl name of ridl data container to push the data to +#' @param publish yes / no +#' +#' @importFrom unhcrdatapackage end_year_population_totals_long +#' @importFrom janitor clean_names +#' +#' @return frame with all compass indicators +#' +#' @export +#' +#' @examples +#' # compass <- export_compass_fill( country = "ECU", +#' # operation = "Ecuador ABC", +#' # year = 2022, +#' # population_type = c("REF","ASY", "OIP"), +#' # population_rms = "Refugees and Asylum-seekers", +#' # rms_indicator = rbind( +#' # c("main", "impact2_2", "2.2 Proportion of PoCs residing in physically safe and +#' # secure settlements with access to basic facilities"), +#' # c("main", "impact2_3", "2.3 Proportion of PoC with access to health services"), +#' # c("P2.S3", "impact3_2a", "3.2a Proportion of PoC enrolled in primary education" ), +#' # c("P2.S3", "impact3_2b", "3.2b Proportion of PoC enrolled in secondary education" ), +#' # c("main", "impact3_3", "3.3 Proportion of PoC feeling safe walking alone in their neighborhood (related SDG 16.1.4)." ), +#' # c("S2", "outcome1_2", "1.2 Proportion of children under 5 years of age whose births +#' # have been registered with a civil authority. [SDG 16.9.1 - Tier 1]" ), +#' # c("S2", "outcome1_3", "1.3 Proportion of PoC with legally recognized identity documents or credentials [GCR 4.2.2]." ), +#' # c("main", "outcome4_1", "4.1 Proportion of PoC who know where to access available GBV services." ), +#' # c("main", "outcome4_2", "4.2 Proportion of POCs who do not accept violence against women." ), +#' # c("main", "outcome8_2", "8.2 Proportion of PoC with primary reliance on clean (cooking) fuels and technology [SDG 7.1.2 Tier 1]" ), +#' # c("main", "outcome9_1", "9.1 Proportion of PoCs living in habitable and affordable housing." ), +#' # c("main", "outcome9_2", "9.2 Proportion of PoC that have energy to ensure lighting (close to Sphere)." ), +#' # c("main","outcome12_1", "12.1 Proportion of PoC using at least basic drinking water services (SDG)." ), +#' # # c("main" , "outcome12_2", "12.2 Proportion of PoC with access to a safe household toilet (SDG)." ), +#' # c("main", "outcome13_1", "13.1. Proportion of PoC with an account at a bank or other +#' # financial institution or with a mobile-money-service provider [SDG 8.10.2 Tier 1]." ), +#' # c("main", "outcome13_2", "13.2. Proportion of PoC who self-report positive changes in their income compared to previous year." ), +#' # c("main", "outcome13_3", "13.3 Proportion of PoC (working age) who are unemployed." ), +#' # c("main", "outcome16_1", "16.1. Proportion of PoC with secure tenure rights and/or +#' # property rights to housing and/or land [revised SDG indicator 1.4.2]." )#, +#' # # c("main", "outcome16_2", "16.2. Proportion of PoC covered by social protection floors/systems [SDG 1.3.1]." ) +#' # ), +#' # ridl = params$ridl, +#' # publish = params$publish ) +compass_table <- function(country , + operation, + year , + population_type, + population_rms, + rms_indicator, + ridl, + publish) { + + + totalBaseline <- unhcrdatapackage::end_year_population_totals_long |> + filter(CountryAsylumCode == country, + Year == 2022 , + Population.type %in% population_type) |> + group_by(CountryAsylumName) |> + summarise(Value = sum(Value, na.rm = TRUE)) |> + ungroup() |> + dplyr::pull( Value) + + rms_indicator = as.data.frame(rms_indicator) + + ## Initialise the data frame + compass <- data.frame( t(c( a = operation, + b = population_rms, + c = "Percent", + d = totalBaseline, + e = 10, + f = 10, + g = "XXX" )) ) + + ## append all the values + for (i in (1:nrow(rms_indicator))) { + # i <- 3 + t <- as.data.frame(eval(parse(text= paste0("table( datalist[[\"", + rms_indicator[i,1] , + "\"]]$", + rms_indicator[i, 2] ,")" ) ))) + #cat( paste0(rms_indicator[i,3] , "\n")) + + #class(t) + if( nrow(t) == 0) { + t1 <- 0 } else if( nrow(t |> dplyr::filter(Var1 ==1 )) == 1) { + t1 <- eval(parse(text= paste0("as.data.frame( prop.table(table( datalist[[\"", + rms_indicator[i,1],"\"]]$", + rms_indicator[i,2],"))) |> + dplyr::filter(Var1 ==1 ) |> dplyr::pull(Freq)"))) } else { + t1 <- 0} + compass1 <- as.data.frame(t(c( a = operation, + b = population_rms, + c = "Percent", + d = totalBaseline, + e = round(t1 * 100,2), + f = round(totalBaseline *t1), + g = rms_indicator[i,3] ))) + #str(compass) + #str(compass1) + compass <- rbind( compass,compass1) + rm(compass1) + } + + compass <- compass |> + as.data.frame() |> + dplyr::slice(-1) |> + dplyr::mutate (Plan = a , + `Population Type (operational)` = b , + `Show As` = c, + `Baseline Num.` = f, + `Baseline Den.` = d, + `%` = e , + `Indicator` = g)|> + dplyr::select(Plan, + `Indicator`, + `Population Type (operational)`, + `Show As`, + `Baseline Num.`, + `Baseline Den.`, + `%` ) + + ## And now saving + ## Create a new workbook + wb <- openxlsx::createWorkbook() + ## add the cleaning log to the file + openxlsx::addWorksheet(wb, "Compass") + openxlsx::writeData(wb, "Compass", + compass, withFilter = TRUE) + ## Save workbook + openxlsx::saveWorkbook(wb, + file = here::here(paste0("compass_", + country,"_", + stringr::str_replace_all(string=population_rms, pattern=" ", repl=""), + ".xlsx") ), + overwrite = TRUE) + + + ## Now push to RILD + if( publish == "yes"){ + p <- riddle::dataset_show(param$ridl) + list_of_resources <- p[["resources"]][[1]] + + time <- format(Sys.Date(), '%d%b%y') + ### Publish the analysis plan #### + namecompass = paste0("compass_", country,"_", + stringr::str_replace_all(string=population_rms, pattern=" ", repl="")) + ### Check if the name is already in the resources + if(namecompass %in% list_of_resources$name) { + ## get the resource id + resourceid <- list_of_resources |> + dplyr::filter ( name == namecompass) |> + dplyr::pull(id) + ## get the new resource version + curversion <- list_of_resources |> + dplyr::filter ( name == namecompass) |> + dplyr::pull(version) + + ## Build resource metadata + metadatacompass <- riddle::resource_metadata( + type = "attachment", + url = paste0(namecompass, ".xlsx"), + name = namecompass, + description = paste0("Compass output generated from RMS on ", time, + ". Built using kobocruncher "), + format = "xlsx", + version = (curversion + 1), + visibility = "public", + file_type = "other", + ## Revise here based on the name from your crunching report + upload = httr::upload_file(here::here(paste0(namecompass, ".xlsx"))) + ) + riddle::resource_update(id = resourceid, + res_metadata = metadatacompass) + } else { + + metadatacompass <- riddle::resource_metadata( + type = "attachment", + url = paste0(namecompass, ".xlsx"), + name = namecompass, + description = paste0("Compass output generated from RMS on ", time, + ". Built using kobocruncher "), + format = "xlsx", + visibility = "public", + file_type = "other", + ## Revise here based on the name from your crunching report + upload = httr::upload_file(here::here(paste0(namecompass, ".xlsx"))) + ) + riddle::resource_create(package_id = p$id, + res_metadata = metadatacompass) + } + + } + + return(compass) + +} diff --git a/R/kobo_dummy.R b/R/kobo_dummy.R index 6acf505..20750d4 100644 --- a/R/kobo_dummy.R +++ b/R/kobo_dummy.R @@ -37,6 +37,10 @@ #' 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")) kobo_dummy <- function(form, n = 384, file){ @@ -81,6 +85,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)) ) { @@ -179,6 +184,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 @@ -206,7 +215,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 diff --git a/R/mod_apply_calculation.R b/R/mod_apply_calculation.R index 949334b..d7d742c 100644 --- a/R/mod_apply_calculation.R +++ b/R/mod_apply_calculation.R @@ -30,7 +30,16 @@ mod_apply_calculation_ui <- function(id) { solidHeader = FALSE, collapsible = TRUE, width = 12, - "Content" + "Content", + downloadButton( inputId = ns("getdata"), + label = " get Data ", + width = "100%" ), + downloadButton( inputId = ns("getreport"), + label = " get Report ", + width = "100%" ), + downloadButton( inputId = ns("getanalysisplan"), + label = " get Extended XlsFrom with Indicators calculation ", + width = "100%" ) ## do not forget that all elements ID of the GUI needs to be called with ns("ID").... ) @@ -47,6 +56,78 @@ mod_apply_calculation_ui <- function(id) { mod_apply_calculation_server <- function(input, output, session, AppReactiveValue) { ns <- session$ns ## add here the server logic part of your module.... + output$downloadreport <- downloadHandler( + filename = "exploration_report.html", + content = function(file) { + # Copy the report file and form to a temporary directory before processing it, in + # case we don't have write permissions to the current working dir (which + # can happen when deployed). + tempReport <- file.path(AppReactiveValue$thistempfolder, + "report.Rmd") + + ## Copy the report notebook template in the tempfolder.. + file.copy(system.file("rmarkdown/templates/rms_report/skeleton/skeleton.Rmd", + package = "kobocruncher"), + tempReport, overwrite = TRUE) + + ## tweak to get here::here working - create .here file + file.create( paste0(AppReactiveValue$thistempfolder, "/.here") , + "/.here") + + ## paste the form in the data-raw folder for further knitting + file.copy( AppReactiveValue$xlsformpath, + paste0(AppReactiveValue$thistempfolder, + "/data-raw/", + AppReactiveValue$xlsformname), + overwrite = TRUE) + + ## A few check in the console... + print(paste0( "thistempfolder: ", AppReactiveValue$thistempfolder)) + print(paste0( "xlsformname: ", AppReactiveValue$xlsformname)) + print(paste0( "datauploadname: ", AppReactiveValue$datauploadname)) + + + + #browser() + # Set up parameters to pass to Rmd document + params = list( + # datafolder= "", + data = AppReactiveValue$datauploadname, + form = AppReactiveValue$xlsformname, + # ridl = ridl, + # datasource = AppReactiveValue$datasource, + # publish = publish, + # visibility= visibility, + # stage = stage, + language = AppReactiveValue$language ) + + showModal(modalDialog("Please wait, compiling the report... The more questions in your report, the more time it will take...", footer=NULL)) + # Knit the document, passing in the `params` list, and eval it in a + # child of the global environment (this isolates the code in the document + # from the code in this app). + rmarkdown::render(tempReport, + output_file = file, + params = params, + envir = new.env(parent = globalenv()) + + ) + removeModal() + } + ) + + ## Get download ready for expanded form + output$getdata <- downloadHandler( + filename = function(){paste0("Indicator_data.xlsx") }, + content <- function(file) { file.copy( AppReactiveValue$indicatordata , file)} + ) + ## Get download ready for expanded form + output$getanalysisplan <- downloadHandler( + filename = function(){paste0(AppReactiveValue$xlsformfilename, "_expanded.xlsx") }, + content <- function(file) { file.copy( AppReactiveValue$expandedform , file)} + ) + + + } ## copy to body.R diff --git a/R/mod_home.R b/R/mod_home.R index bcfa788..70f0622 100644 --- a/R/mod_home.R +++ b/R/mod_home.R @@ -16,7 +16,7 @@ mod_home_ui <- function(id) { ### Get the name for your tool p( tags$span("IndicatorCalc ", style = "font-size: 60px"), - tags$span(" Beta", style = "font-size: 24px") + tags$span(" Alpha-version", style = "font-size: 24px") ), br(), ### Then a short explainer @@ -33,13 +33,15 @@ mod_home_ui <- function(id) { 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: ", + p("This app is part of a ",tags$span("companion app toolkit", style = "color:#00B398"), + "designed to mainstream knowledge, automate processes and facilitate standardised documentation of survey implementation. 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.", + tags$a(href="https://rstudio.unhcr.org/kobocruncher/", "KoboCruncher"), " to perform rapid data exploration and ", + tags$a(href="https://rstudio.unhcr.org/IndicatorCalc", "IndicatorCalc"), "compile indicators. + Each App has different maturity level from Alpha Version, Beta version till Candidate Release", style = "font-size: 12px; text-align: left;"), p(tags$i( class = "fa fa-github"), "App built with ", diff --git a/R/mod_variable_mapping.R b/R/mod_variable_mapping.R index dc5bd5e..2670a8e 100644 --- a/R/mod_variable_mapping.R +++ b/R/mod_variable_mapping.R @@ -22,18 +22,127 @@ mod_variable_mapping_ui <- function(id) { ) ), - 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").... - ) + fluidRow( + + + shinydashboard::box( + title = "Project Metadata ", + # status = "primary", + status = "info", + solidHeader = FALSE, + collapsible = TRUE, + #background = "light-blue", + width = 12, + fluidRow( + column( + width = 12, + + selectInput(inputId = ns("ridlyes"), + label = " Is your kobo dataset configured in RIDL?", + choice = c("I Have already documented my kobo dataset in RIDL" = "TRUE", + "Not yet... I will upload the files manually and + pay attention to upload the right data format" = "FALSE"), + selected = TRUE), + + ## If yes - ask for RIDL key - and RIDL dataset ID + div( + id = ns("show_ridl"), + passwordInput(inputId = ns("token"), + label = "Paste below your personal RIDL API token - Note that it will be kept only for your current session"), + + verbatimTextOutput(outputId = ns("validation")), + + textInput(inputId = ns("search"), label = "Use a key word to search among all your dataset!"), + hr(), + + actionButton( inputId = ns("pull"), + label = " Find", + width = "400px" , + icon = icon("magnifying-glass") ), + + selectInput( inputId = ns("ridlprojects"), + label = "Select wich RIDL Project to work in", + choice = c("Waiting for token..." = "" ), + width = "100%" ), + + actionButton( inputId = ns("pull2"), + label = " Pull selected RIDL Dataset", + icon = icon("filter"), + width = "400px" ) + ## Then pull metadata and display them in in a Verbatim- + ), + ## If no ask for at least the datasource name to reference in the graph + div( + id = ns("noshow_ridl"), + # textInput( inputId = ns("datasource"), + # label = "Provide a short name for your survey to be added + # in each chart caption" ), + + ) + + + ) + ), + + fluidRow( + column( + width = 6, + h3("Form"), + div( + id = ns("show_ridl2"), + selectInput( inputId = ns("ridlform"), + label = "Confirm the attachment that contains the form + or an already extended version of the form", + choice = c("Waiting for selected project..."=".."), + width = "100%" ), + + actionButton( inputId = ns("pull3"), + label = " Pull in session and map variable!", + icon = icon("upload"), + width = "100%" ) + ), + div( + id = ns("noshow_ridl2"), + fileInput(inputId = ns("xlsform"), + label = "Load your XlsForm", + multiple = F), + actionButton( inputId = ns("pull5"), + label = " Map variables!", + icon = icon("map-location"), + width = "100%" ) + ), + + + ), + + column( + width = 6, + h3("Data"), + div( + id = ns("show_ridl3"), + selectInput( inputId = ns("ridldata"), + label = "Confirm the attachment that contains the right data version", + choice = c("Waiting for selected project..."=".."), + width = "100%" ) , + actionButton( inputId = ns("pull4"), + label = " Pull in session!", + icon = icon("upload"), + width = "100%" ) + ), + div( + id = ns("noshow_ridl3"), + fileInput(inputId = ns("dataupload"), + label = "Load your data", + multiple = F, + width = "100%" ) + ) + ) + ) + + + + ) ) ) } @@ -46,7 +155,307 @@ mod_variable_mapping_ui <- function(id) { mod_variable_mapping_server <- function(input, output, session, AppReactiveValue) { ns <- session$ns -## add here the server logic part of your module.... + observeEvent(input$ridlyes, { + AppReactiveValue$ridlyes <- input$ridlyes + ## No need to show budget if the population is reg and trceable is know + #print(AppReactiveValue$ridlyes) + if( AppReactiveValue$ridlyes == TRUE) { + AppReactiveValue$showridl <- TRUE + } else if( AppReactiveValue$ridlyes == FALSE) { + AppReactiveValue$showridl <- FALSE } + }) + + ## Manage visibility for RIDL mode.... + observeEvent(AppReactiveValue$showridl, { + #print( paste0( "showrild: ", AppReactiveValue$showridl, " --", ns("show_ridl"))) + if(isTRUE(AppReactiveValue$showridl)) { + golem::invoke_js("show", paste0("#", ns("show_ridl"))) + golem::invoke_js("hide", paste0("#", ns("noshow_ridl"))) + } else { + golem::invoke_js("hide", paste0("#", ns("show_ridl"))) + golem::invoke_js("show", paste0("#", ns("noshow_ridl"))) + } + }) + + + observeEvent(input$token, { + AppReactiveValue$token <- input$token + }) + + output$validation <- renderPrint({ + validate( + need( isTruthy(input$token), # input$token != "" + message ="Token should not be empty"), + need( nchar(input$token) == 224, + message ="Token should be 224 characters" ), + need( grepl(pattern = "[a-z]", x = input$token), + message = "Token should contain at least one lower-case letter"), + # need( grepl(pattern = "[A-Z]", x = input$token), + # "Token should contain at least one upper-case letter" + # ), + need( grepl(pattern = "[:digit:]", x = input$token), + message = "Token should contain a number" ) + ) + "Token valid: Can now connect to the server...." + AppReactiveValue$token2 <- AppReactiveValue$token + }) + + observeEvent(input$search, { + AppReactiveValue$search <- input$search + }) + + + + ## filtering a list of ridl datasets ########### + observeEvent(input$pull, { + ## We wait till users get to search to inject the token value.. + req(AppReactiveValue$token2) + Sys.setenv("RIDL_API_TOKEN" = AppReactiveValue$token2) + #print( Sys.getenv("RIDL_API_TOKEN")) + # print(Sys.getenv("RIDL_API_TOKEN")) + # print(AppReactiveValue$token2) + ## Check we have something in the search + req(AppReactiveValue$search) + # print(AppReactiveValue$search) + #query <- dplyr::last(AppReactiveValue$search) + AppReactiveValue$query <- dplyr::last(AppReactiveValue$search) + req(AppReactiveValue$query) + + ## some message for user... + data_message <- utils::capture.output({ + showModal(modalDialog("Working on it...", footer=NULL)) + + AppReactiveValue$dataset0 <<- riddle::dataset_search( + q = AppReactiveValue$query, + rows = 40) + }, type = "message") + removeModal() + + if(is.null(AppReactiveValue$dataset0)){ + # not successful + shinyWidgets::sendSweetAlert( + session = session, + title = "Problem with Token", + text = "Please check you used the correct one...", + type = "warning" + ) + } else { + shinyWidgets::sendSweetAlert( + session = session, + title = "Done", + text = "List of dataset is retrieved.", + type = "success" ) + } + + req(AppReactiveValue$dataset0) + AppReactiveValue$dataset <- as.data.frame(AppReactiveValue$dataset0 |> + dplyr::select(id, kobo_asset_id, + title, operational_purpose_of_data, + geographies, type)) |> + dplyr::filter( !(is.null(kobo_asset_id))) |> + dplyr::filter( !(is.na(kobo_asset_id))) |> + dplyr::filter( !(kobo_asset_id == "")) |> + dplyr::filter( type == "dataset") |> + dplyr::mutate (label = glue::glue('{title} (purpose: {operational_purpose_of_data}, {geographies}) ')) + + ## Create dropdown content with summary from ridlprojects... only when there's a linkedkoboAsset + req(AppReactiveValue$dataset) + AppReactiveValue$groupName <- AppReactiveValue$dataset |> + dplyr::pull( id) |> + purrr::set_names(AppReactiveValue$dataset |> + dplyr::pull(label) ) + ## update dropdown + updateSelectInput(session, + "ridlprojects", + choices = AppReactiveValue$groupName ) + }) + + + ## Getting the selected ridl dataset ########### + observeEvent(input$ridlprojects, { + AppReactiveValue$ridlprojects <- input$ridlprojects + }) + + + + ## filtering a list of ridl datasets ########### + observeEvent(input$pull2, { + # browser() + req(AppReactiveValue$dataset0) + AppReactiveValue$thisdataset <- AppReactiveValue$dataset0 |> + dplyr::filter( id == AppReactiveValue$ridlprojects) + # + AppReactiveValue$resources <- AppReactiveValue$thisdataset[["resources"]][[1]] + # c("cache_last_updated", "cache_url", "created", "datastore_active", + # "description", "file_type", "format", "hash", "id", "kobo_details", + # "kobo_type", "last_modified", "metadata_modified", "mimetype", + # "mimetype_inner", "name", "package_id", "position", "resource_type", + # "size", "state", "type", "url", "url_type", "visibility", "date_range_end", + # "date_range_start", "identifiability", "process_status", "version" ) + + AppReactiveValue$form <- AppReactiveValue$resources |> + dplyr::filter( file_type == "questionnaire") |> + dplyr::filter( format == "XLS") |> + dplyr::pull( url) |> + purrr::set_names(AppReactiveValue$resources |> + dplyr::filter( file_type == "questionnaire") |> + dplyr::filter( format == "XLS") |> + dplyr::mutate (label = glue::glue('{file_type} ({format}) '))|> + dplyr::pull(label) ) + + + + AppReactiveValue$data <- AppReactiveValue$resources |> + dplyr::filter( file_type == "microdata") |> + dplyr::filter( format == "XLSX") |> + dplyr::pull( url) |> + purrr::set_names(AppReactiveValue$resources |> + dplyr::filter( file_type == "microdata") |> + dplyr::filter( format == "XLSX") |> + dplyr::mutate (label = glue::glue('{file_type} ({format}, {process_status}) '))|> + dplyr::pull(label) ) + + }) + + ## Manage visibility for RIDL mode.... + observeEvent(AppReactiveValue$showridl, { + if(isTRUE(AppReactiveValue$showridl)) { + golem::invoke_js("show", paste0("#", ns("show_ridl2"))) + golem::invoke_js("hide", paste0("#", ns("noshow_ridl2"))) + golem::invoke_js("show", paste0("#", ns("show_ridl3"))) + golem::invoke_js("hide", paste0("#", ns("noshow_ridl3"))) + } else { + golem::invoke_js("hide", paste0("#", ns("show_ridl2"))) + golem::invoke_js("show", paste0("#", ns("noshow_ridl2"))) + golem::invoke_js("hide", paste0("#", ns("show_ridl3"))) + golem::invoke_js("show", paste0("#", ns("noshow_ridl3"))) + } + }) + + ## Case 1 -- uploading data + observeEvent(input$dataupload,{ + req(input$dataupload) + message("Please upload a file") + AppReactiveValue$datauploadpath <- input$dataupload$datapath + AppReactiveValue$thistempfolder <- dirname(AppReactiveValue$datauploadpath) + AppReactiveValue$datauploadname <- input$dataupload$name + + ## Create a sub folder data-raw and paste data there + dir.create(file.path(AppReactiveValue$thistempfolder, "data-raw"), showWarnings = FALSE) + ## Move the data there... + file.copy( AppReactiveValue$datauploadpath, + paste0(AppReactiveValue$thistempfolder, + "/data-raw/", + # fs::path_file(AppReactiveValue$datauploadpath)), + AppReactiveValue$datauploadname), + overwrite = TRUE) + }) + + ## Case 1 -- uploading xlsform + observeEvent(input$xlsform,{ + req(input$xlsform) + message("Please upload a file") + AppReactiveValue$xlsformpath <- input$xlsform$datapath + AppReactiveValue$xlsformname <- input$xlsform$name + + + + ## extract file name + AppReactiveValue$xlsformfilename <- + stringr::str_to_lower( + stringr::str_replace_all( + stringr::str_remove( + input$xlsform$name, + ".xlsx"), + stringr::regex("[^a-zA-Z0-9]"), "_")) + + ## Define the path and name for the expanded version + AppReactiveValue$expandedform <- paste0( dirname(AppReactiveValue$xlsformpath) , + "/", + AppReactiveValue$xlsformfilename, + "_expanded.xlsx") + ## Generate expanded form + kobo_prepare_form(xlsformpath = AppReactiveValue$xlsformpath, + label_language = AppReactiveValue$language, + xlsformpathout = AppReactiveValue$expandedform ) + + }) + + + + + ### Case 2 - fill dropdown + observe({ + req(AppReactiveValue$form) + updateSelectInput(session, + "ridlform", + choices = AppReactiveValue$form ) + req(AppReactiveValue$data) + updateSelectInput(session, + "ridldata", + choices = AppReactiveValue$data ) + }) + + ### Case 2 -- download data from RIDL + observeEvent(input$ridldata, { + AppReactiveValue$ridldata <- input$ridldata + }) + + observeEvent(input$pull4, { + ### So let's fetch the resource and create the corresponding reactive objects + # for the rest of the flow... + + showModal(modalDialog("Please wait, pulling all the files from the server at the moment...", footer=NULL)) + ## now the data + req(AppReactiveValue$ridldata) + AppReactiveValue$datauploadpath <- tempfile() + riddle::resource_fetch(url = AppReactiveValue$ridldata, + path = AppReactiveValue$datauploadpath) + AppReactiveValue$thistempfolder <- dirname(AppReactiveValue$datauploadpath) + AppReactiveValue$datauploadname <- basename(AppReactiveValue$datauploadpath) + ## Create a subfolder + dir.create(file.path(AppReactiveValue$thistempfolder, "data-raw"), showWarnings = FALSE) + ## Move the data there... + file.copy( AppReactiveValue$datauploadpath, + paste0(AppReactiveValue$thistempfolder, + "/data-raw/", + # fs::path_file(AppReactiveValue$datauploadpath)), + AppReactiveValue$datauploadname), + overwrite = TRUE) + + removeModal() + + }) + + + ### Case 2 -- download Form from RIDL + observeEvent(input$ridlform, { + AppReactiveValue$ridlform <- input$ridlform + }) + observeEvent(input$pull3, { + showModal(modalDialog("Please wait, pulling all the files from the server at the moment...", footer=NULL)) + req(AppReactiveValue$ridlform) + AppReactiveValue$xlsformpath <- tempfile() + riddle::resource_fetch(url = AppReactiveValue$ridlform, + path = AppReactiveValue$xlsformpath) + ## Get the name for the file... + AppReactiveValue$xlsformname <- basename(AppReactiveValue$xlsformpath) + + + removeModal() + }) + + + ### Apply form preparation... + observeEvent(input$language, { + AppReactiveValue$language <- input$language + ## if language change, regenerate the expanded form + req(AppReactiveValue$xlsformpath ) + kobo_prepare_form(xlsformpath = AppReactiveValue$xlsformpath, + label_language = AppReactiveValue$language, + xlsformpathout = AppReactiveValue$expandedform ) + }) + } ## copy to body.R diff --git a/README.Rmd b/README.Rmd index a577af1..61897b6 100644 --- a/README.Rmd +++ b/README.Rmd @@ -20,7 +20,7 @@ knitr::opts_chunk$set( There is broad consensus around the key indicators used to measure, inform and monitor progress towards global development objectives, as exemplified by the Sustainable Development Goals and related efforts of the MICS, DHS, IHSN, together with national governments. UNHCR's objectives are largely aligned with these frameworks. [UNHCR Results Monitoring Surveys (RMS)](https://intranet.unhcr.org/en/support-services/common-good-data-initiatives/household-surveys/Results-Monitoring-Surveys.html) are household-level surveys with standard questionnaires following context-appropriate methodological approaches. They can be implemented across UNHCR operations to monitor changes in the lives of all relevant groups of persons of concern (impacts) and in UNHCR's key areas of engagement (outcomes). RMS help us to calculate impact and outcome indicators in a standardized way to have a global understanding of the results. Both indicators and questionnaire is also largely aligned with MICS, DHS, IHSN, national household surveys and other UNHCR standardized surveys. -The goal of {IndicatorCalc} is to ease the implementation of standard calculations for survey indicators related to Forcibly Displaced Population. +The goal of `{IndicatorCalc}` is to ease the implementation of standard calculations for survey indicators related to Forcibly Displaced Population. Among the objectives is also to avoid duplication of documentation efforts around the information to include in the technical report and the information that is already expected to be gathered and recorded within [UNHCR Internal Data Repository](http://ridl.unhcr.org) which is following [Data Documentation Initiative](https://ddialliance.org/) standards. The package is designed to work based on dataset standard backup format exported from [kobotoolbox](http://http://kobo.unhcr.org) within [UNHCR internal data repository](http://ridl.unhcr.org). It is adapted from the initial [indicator script](https://github.com/bozdagilgi/UNHCR-RMS-Indicators) version. @@ -30,32 +30,40 @@ Each calculation is implemented as a function with in-built check to identify wh ## 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 easiest way to use the package is through its [shiny Companion App](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 + 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 +## Console user / Developpers You can install the development version of {IndicatorCalc} from [GitHub](https://github.com/unhcr-americas/IndicatorCalc) with: ``` r -# install.packages("devtools") -devtools::install_github("unhcr-americas/IndicatorCalc") +install.packages("pak") +pak::pkg_install("unhcr-americas/IndicatorCalc") ``` -The package development roadmap includes: +The `{riddle}` package is used to ensure integration with [UNHCR Data Repository](https://ridl.unhcr.org). +It requires you to add your __API token__ and store it for further use. +The easiest way to do that is to store your API token in your `.Renviron` file which +is automatically read by R on startup. + +You can retrieve your `API TOKEN` in your [user page](https://ridl.unhcr.org/user/). + +![api_token_img](https://raw.githubusercontent.com/Edouard-Legoupil/riddle/main/inst/token.png) + +To use the package, you’ll need to store your RIDL API token in the `RIDL_API_TOKEN` environment variable. +The easiest way to do that is by calling `usethis::edit_r_environ()` and adding the line +`RIDL_API_TOKEN=xxxxx` to the file before saving and restarting your R session. + - - a dummy data generator - - an SDG comparison plot.. - - a report template to output a quick exploration of all indicators results - - a shiny app to provide access to the package online with Rstudio connect (versus offline rstudio) diff --git a/README.md b/README.md index 3cbba90..615d3ee 100644 --- a/README.md +++ b/README.md @@ -23,9 +23,14 @@ results. Both indicators and questionnaire is also largely aligned with MICS, DHS, IHSN, national household surveys and other UNHCR standardized surveys. -The goal of {IndicatorCalc} is to ease the implementation of standard +The goal of `{IndicatorCalc}` is to ease the implementation of standard calculations for survey indicators related to Forcibly Displaced -Population. +Population. Among the objectives is also to avoid duplication of +documentation efforts around the information to include in the technical +report and the information that is already expected to be gathered and +recorded within [UNHCR Internal Data Repository](http://ridl.unhcr.org) +which is following [Data Documentation +Initiative](https://ddialliance.org/) standards. The package is designed to work based on dataset standard backup format exported from [kobotoolbox](http://http://kobo.unhcr.org) within [UNHCR @@ -41,34 +46,57 @@ is expected. You can check each [function reference](/reference/index.html) to see in details all documented calculations -*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 +The easiest way to use the package is through its [shiny Companion +App](http://rstudio.unhcr.org/IndicatorCalc) and then follow the instruction from there. -## Developpers +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) + +## Console user / Developpers You can install the development version of {IndicatorCalc} from [GitHub](https://github.com/unhcr-americas/IndicatorCalc) with: ``` r -# install.packages("devtools") -devtools::install_github("unhcr-americas/IndicatorCalc") +install.packages("pak") +pak::pkg_install("unhcr-americas/IndicatorCalc") ``` -The package development roadmap includes: +The `{riddle}` package is used to ensure integration with [UNHCR Data +Repository](https://ridl.unhcr.org). It requires you to add your **API +token** and store it for further use. The easiest way to do that is to +store your API token in your `.Renviron` file which is automatically +read by R on startup. + +You can retrieve your `API TOKEN` in your [user +page](https://ridl.unhcr.org/user/). + +
+ + +
-- a dummy data generator -- an SDG comparison plot.. -- a report template to output a quick exploration of all indicators - results -- a shiny app to provide access to the package online with Rstudio - connect (versus offline rstudio) +To use the package, you’ll need to store your RIDL API token in the +`RIDL_API_TOKEN` environment variable. The easiest way to do that is by +calling `usethis::edit_r_environ()` and adding the line +`RIDL_API_TOKEN=xxxxx` to the file before saving and restarting your R +session. diff --git a/dev/config_fusen.yaml b/dev/config_fusen.yaml index 4327313..48babca 100644 --- a/dev/config_fusen.yaml +++ b/dev/config_fusen.yaml @@ -33,6 +33,7 @@ utilities.Rmd: path: dev/utilities.Rmd state: active R: + - R/compass_table.R - R/kobo_dummy.R - R/plot_rbm_sdg.R - R/var_dummy.R @@ -40,6 +41,7 @@ utilities.Rmd: - tests/testthat/test-var_dummy.R - tests/testthat/test-kobo_dummy.R - tests/testthat/test-plot_rbm_sdg.R + - tests/testthat/test-compass_table.R vignettes: vignettes/utilities.Rmd inflate: flat_file: dev/utilities.Rmd diff --git a/dev/utilities.Rmd b/dev/utilities.Rmd index 82abe03..ff1e50a 100644 --- a/dev/utilities.Rmd +++ b/dev/utilities.Rmd @@ -708,6 +708,230 @@ test_that("plot_rbm_sdg works", { + +## compass_table + +```{r function-compass_table} +#' @title Write simple compass indicator table +#' @description The function take the list of calculated variables from an RMS +#' and output an excel document in the same folder with the correct +#' format for import into COMPASS. +#' +#' The function assumes you have already calculated the indicators and +#' have a datalist object with all the correct calculation inside +#' +#' @param country iso3 code for the country (easier to recall than the M49 used in the API) +#' @param operation operation name +#' @param year year to use to extract the baseline from Population Statistics +#' @param population_type The list of population type for baseline calculation +#' @param population_rms The list of population type covered by RMS +#' @param rms_indicator list with indicators and their related frame to pull the value +#' @param ridl name of ridl data container to push the data to +#' @param publish yes / no +#' +#' @importFrom unhcrdatapackage end_year_population_totals_long +#' @importFrom janitor clean_names +#' +#' @return frame with all compass indicators +#' +#' @export +#' +compass_table <- function(country , + operation, + year , + population_type, + population_rms, + rms_indicator, + ridl, + publish) { + + + totalBaseline <- unhcrdatapackage::end_year_population_totals_long |> + filter(CountryAsylumCode == country, + Year == 2022 , + Population.type %in% population_type) |> + group_by(CountryAsylumName) |> + summarise(Value = sum(Value, na.rm = TRUE)) |> + ungroup() |> + dplyr::pull( Value) + + rms_indicator = as.data.frame(rms_indicator) + + ## Initialise the data frame + compass <- data.frame( t(c( a = operation, + b = population_rms, + c = "Percent", + d = totalBaseline, + e = 10, + f = 10, + g = "XXX" )) ) + + ## append all the values + for (i in (1:nrow(rms_indicator))) { + # i <- 3 + t <- as.data.frame(eval(parse(text= paste0("table( datalist[[\"", + rms_indicator[i,1] , + "\"]]$", + rms_indicator[i, 2] ,")" ) ))) + #cat( paste0(rms_indicator[i,3] , "\n")) + + #class(t) + if( nrow(t) == 0) { + t1 <- 0 } else if( nrow(t |> dplyr::filter(Var1 ==1 )) == 1) { + t1 <- eval(parse(text= paste0("as.data.frame( prop.table(table( datalist[[\"", + rms_indicator[i,1],"\"]]$", + rms_indicator[i,2],"))) |> + dplyr::filter(Var1 ==1 ) |> dplyr::pull(Freq)"))) } else { + t1 <- 0} + compass1 <- as.data.frame(t(c( a = operation, + b = population_rms, + c = "Percent", + d = totalBaseline, + e = round(t1 * 100,2), + f = round(totalBaseline *t1), + g = rms_indicator[i,3] ))) + #str(compass) + #str(compass1) + compass <- rbind( compass,compass1) + rm(compass1) + } + + compass <- compass |> + as.data.frame() |> + dplyr::slice(-1) |> + dplyr::mutate (Plan = a , + `Population Type (operational)` = b , + `Show As` = c, + `Baseline Num.` = f, + `Baseline Den.` = d, + `%` = e , + `Indicator` = g)|> + dplyr::select(Plan, + `Indicator`, + `Population Type (operational)`, + `Show As`, + `Baseline Num.`, + `Baseline Den.`, + `%` ) + + ## And now saving + ## Create a new workbook + wb <- openxlsx::createWorkbook() + ## add the cleaning log to the file + openxlsx::addWorksheet(wb, "Compass") + openxlsx::writeData(wb, "Compass", + compass, withFilter = TRUE) + ## Save workbook + openxlsx::saveWorkbook(wb, + file = here::here(paste0("compass_", + country,"_", + stringr::str_replace_all(string=population_rms, pattern=" ", repl=""), + ".xlsx") ), + overwrite = TRUE) + + + ## Now push to RILD + if( publish == "yes"){ + p <- riddle::dataset_show(param$ridl) + list_of_resources <- p[["resources"]][[1]] + + time <- format(Sys.Date(), '%d%b%y') + ### Publish the analysis plan #### + namecompass = paste0("compass_", country,"_", + stringr::str_replace_all(string=population_rms, pattern=" ", repl="")) + ### Check if the name is already in the resources + if(namecompass %in% list_of_resources$name) { + ## get the resource id + resourceid <- list_of_resources |> + dplyr::filter ( name == namecompass) |> + dplyr::pull(id) + ## get the new resource version + curversion <- list_of_resources |> + dplyr::filter ( name == namecompass) |> + dplyr::pull(version) + + ## Build resource metadata + metadatacompass <- riddle::resource_metadata( + type = "attachment", + url = paste0(namecompass, ".xlsx"), + name = namecompass, + description = paste0("Compass output generated from RMS on ", time, + ". Built using kobocruncher "), + format = "xlsx", + version = (curversion + 1), + visibility = "public", + file_type = "other", + ## Revise here based on the name from your crunching report + upload = httr::upload_file(here::here(paste0(namecompass, ".xlsx"))) + ) + riddle::resource_update(id = resourceid, + res_metadata = metadatacompass) + } else { + + metadatacompass <- riddle::resource_metadata( + type = "attachment", + url = paste0(namecompass, ".xlsx"), + name = namecompass, + description = paste0("Compass output generated from RMS on ", time, + ". Built using kobocruncher "), + format = "xlsx", + visibility = "public", + file_type = "other", + ## Revise here based on the name from your crunching report + upload = httr::upload_file(here::here(paste0(namecompass, ".xlsx"))) + ) + riddle::resource_create(package_id = p$id, + res_metadata = metadatacompass) + } + + } + + return(compass) + +} +``` + +```{r example-compass_table} +# compass <- export_compass_fill( country = "ECU", +# operation = "Ecuador ABC", +# year = 2022, +# population_type = c("REF","ASY", "OIP"), +# population_rms = "Refugees and Asylum-seekers", +# rms_indicator = rbind( +# c("main", "impact2_2", "2.2 Proportion of PoCs residing in physically safe and +# secure settlements with access to basic facilities"), +# c("main", "impact2_3", "2.3 Proportion of PoC with access to health services"), +# c("P2.S3", "impact3_2a", "3.2a Proportion of PoC enrolled in primary education" ), +# c("P2.S3", "impact3_2b", "3.2b Proportion of PoC enrolled in secondary education" ), +# c("main", "impact3_3", "3.3 Proportion of PoC feeling safe walking alone in their neighborhood (related SDG 16.1.4)." ), +# c("S2", "outcome1_2", "1.2 Proportion of children under 5 years of age whose births +# have been registered with a civil authority. [SDG 16.9.1 - Tier 1]" ), +# c("S2", "outcome1_3", "1.3 Proportion of PoC with legally recognized identity documents or credentials [GCR 4.2.2]." ), +# c("main", "outcome4_1", "4.1 Proportion of PoC who know where to access available GBV services." ), +# c("main", "outcome4_2", "4.2 Proportion of POCs who do not accept violence against women." ), +# c("main", "outcome8_2", "8.2 Proportion of PoC with primary reliance on clean (cooking) fuels and technology [SDG 7.1.2 Tier 1]" ), +# c("main", "outcome9_1", "9.1 Proportion of PoCs living in habitable and affordable housing." ), +# c("main", "outcome9_2", "9.2 Proportion of PoC that have energy to ensure lighting (close to Sphere)." ), +# c("main","outcome12_1", "12.1 Proportion of PoC using at least basic drinking water services (SDG)." ), +# # c("main" , "outcome12_2", "12.2 Proportion of PoC with access to a safe household toilet (SDG)." ), +# c("main", "outcome13_1", "13.1. Proportion of PoC with an account at a bank or other +# financial institution or with a mobile-money-service provider [SDG 8.10.2 Tier 1]." ), +# c("main", "outcome13_2", "13.2. Proportion of PoC who self-report positive changes in their income compared to previous year." ), +# c("main", "outcome13_3", "13.3 Proportion of PoC (working age) who are unemployed." ), +# c("main", "outcome16_1", "16.1. Proportion of PoC with secure tenure rights and/or +# property rights to housing and/or land [revised SDG indicator 1.4.2]." )#, +# # c("main", "outcome16_2", "16.2. Proportion of PoC covered by social protection floors/systems [SDG 1.3.1]." ) +# ), +# ridl = params$ridl, +# publish = params$publish ) +``` + +```{r tests-compass_table} +test_that("compass_table works", { + expect_true(inherits(compass_table, "function")) +}) +``` +