Skip to content

Commit

Permalink
add report template
Browse files Browse the repository at this point in the history
  • Loading branch information
Edouard-Legoupil committed Oct 31, 2023
1 parent caf107f commit 6e43cfe
Show file tree
Hide file tree
Showing 12 changed files with 1,037 additions and 51 deletions.
11 changes: 10 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -38,12 +45,14 @@ Imports:
systemfonts,
tibble,
tidyr,
tidyverse,
unhcrdatapackage,
unhcrshiny,
unhcrthemes,
utils,
withr
Suggests:
knitr,
rmarkdown,
testthat
VignetteBuilder:
knitr
Expand Down
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -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)
Expand Down Expand Up @@ -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)
Expand Down
1 change: 1 addition & 0 deletions R/body.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
body <- function() {
shinydashboard::dashboardBody(
unhcrshiny::theme_shinydashboard_unhcr(),
golem::activate_js(),
tags$head(
tags$script(src = "custom.js")
),
Expand Down
212 changes: 212 additions & 0 deletions R/compass_table.R
Original file line number Diff line number Diff line change
@@ -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)

}
10 changes: 9 additions & 1 deletion R/kobo_dummy.R
Original file line number Diff line number Diff line change
Expand Up @@ -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){
Expand Down Expand Up @@ -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)) ) {
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 6e43cfe

Please sign in to comment.