-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
caf107f
commit 6e43cfe
Showing
12 changed files
with
1,037 additions
and
51 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) | ||
|
||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.