rev

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: 

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)

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)
 }

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")
     )
   )
 }

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")
 }

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)
+  }

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)
+