[feat] #22 add additional checks..

DESCRIPTION

@@ -9,15 +9,16 @@ Description: What the package does (one paragraph).
 License: MIT + file LICENSE
 Imports: 
     config (>= 0.3.1),
+    dashboardthemes,
     dplyr,
-    dashboardthemes, 
-    shinydashboard,
     golem (>= 0.4.0),
     magrittr,
     purrr,
     R6,
     readxl,
-    shiny (>= 1.7.3)
+    shiny (>= 1.7.3),
+    shinydashboard,
+    stats
 Suggests: 
     knitr,
     prettydoc,

NAMESPACE

@@ -25,3 +25,4 @@ importFrom(readxl,read_xlsx)
 importFrom(shiny,NS)
 importFrom(shiny,shinyApp)
 importFrom(shiny,tagList)
+importFrom(stats,setNames)

R/has_variables_for_indicators.R

@@ -0,0 +1,71 @@
+# WARNING - Generated by {fusen} from /dev/flat_r6_referential.Rmd: do not edit by hand
+
+#' function to check that if an indicator is defined it should map with at
+#'   least one variable from the survey worksheet
+#'
+#' @param path path to the xlsform
+#' 
+#' @importFrom readxl excel_sheets
+#'
+#' @noRd
+has_variables_for_indicators <- function(path){
+
+  # if(all(indicator_disaggregation  %in% get("names_indicator_disaggregation", envir = survey_designer)) ){
+  #   return(indicator_disaggregation)
+  # } else {
+  #   stop("Problem with the name of sheet for indicator_disaggregation")
+  # }
+}
+
+#' function to check that an indicator should map with at least one population
+#'
+#' @param path path to the xlsform
+#' 
+#' @importFrom readxl excel_sheets
+#'
+#' @noRd
+indicator_linked_population <- function(path){
+
+  # if(all(indicator_disaggregation  %in% get("names_indicator_disaggregation", envir = survey_designer)) ){
+  #   return(indicator_disaggregation)
+  # } else {
+  #   stop("Problem with the name of sheet for indicator_disaggregation")
+  # }
+}
+
+#' function to check that if a relation between one population and one indicator
+#'  is recorded, the indicator should also be defined in the indicator frame
+#'
+#' @param path path to the xlsform
+#' 
+#' @importFrom readxl excel_sheets
+#'
+#' @noRd
+population_linked_indicator <- function(path){
+
+  # if(all(indicator_disaggregation  %in% get("names_indicator_disaggregation", envir = survey_designer)) ){
+  #   return(indicator_disaggregation)
+  # } else {
+  #   stop("Problem with the name of sheet for indicator_disaggregation")
+  # }
+}
+
+#' function to check that if an indicator is defined to map with variables 
+#' from the survey worksheet, then all those variables should actually be 
+#' present in the survey frame
+#'
+#' @param path path to the xlsform
+#' 
+#' @importFrom readxl excel_sheets
+#'
+#' @noRd
+indicator_linked_variable <- function(path){
+
+  # if(all(indicator_disaggregation  %in% get("names_indicator_disaggregation", envir = survey_designer)) ){
+  #   return(indicator_disaggregation)
+  # } else {
+  #   stop("Problem with the name of sheet for indicator_disaggregation")
+  # }
+}
+
+

R/names_of_sheet.R

@@ -0,0 +1,219 @@
+# WARNING - Generated by {fusen} from /dev/flat_r6_referential.Rmd: do not edit by hand
+
+survey_designer <- new.env()
+
+assign(
+  "names_sheets", 
+  c("referential_type",
+    "survey",
+    "choices",
+    "indicator",
+    "indicator_survey",
+    "indicator_choices",
+    "indicator_population",
+    "indicator_disaggregation"), 
+  envir = survey_designer)
+
+assign(
+  "names_referential_type", 
+  c("referential_type", "type", "description" ), 
+  envir = survey_designer)
+
+assign(
+  "names_survey", 
+  c("referential_id",  "type" , "name",                     
+  "label", "hint", "required",                 
+ "required_message",  "constraint",  "constraint_message" ,      
+ "relevant" ,  "appearance" , "calculation",              
+ "trigger" ,  "parameters" , "repeat_count" ,            
+ "default",   "read_only"  , "choice_filter" ,           
+  #"media::image" ,
+  #"$given_name",
+ "contextualize" ,           
+  "contextualize_instruction", "block",  "block_sequence" ,          
+  "sequence",  "mode" ,  "check"   ,                 
+  "accuracy",  "chapter", "subchapter" ,              
+  "labelReport", "hintReport", "keyword"  ), 
+  envir = survey_designer)
+
+assign(
+  "names_choices", 
+  c( "referential_id",    "list_name",     "name" ,                    
+     "label" ,  "order" , "contextualize"  ,          
+     "contextualize_instruction", "labelReport"  ), 
+  envir = survey_designer)
+
+assign(
+  "names_indicator", 
+  c( "referential_id", "type" ,   "name",    "labelReport" , "hintReport" , "list_name",     
+  "repeatvar",      "ind_type",  "sequence" ,  "block",   "chapter",    "subchapter" ,   
+ "calculation" ,  "unit"  ,    "accuracy",   "mode_CAPI",   "mode_CATI"  ,   
+ "mode_CAWI",   "metadata",   "link" ,    "keyword" 
+  ), 
+  envir = survey_designer)
+
+assign(
+  "names_indicator_survey", 
+  c( "referential_id", "name" , "name_survey" ), 
+  envir = survey_designer)
+
+assign(
+  "names_indicator_choices", 
+  c( "referential_id", "name" , "name_choices"   ), 
+  envir = survey_designer)
+
+assign(
+  "names_indicator_population", 
+  c( "referential_id", "name",  "name_poulation"  ), 
+  envir = survey_designer)
+
+assign(
+  "names_indicator_disaggregation", 
+  c( "referential_id",  "name" ,  "name_dissagregation" ), 
+  envir = survey_designer)
+
+#' function to check name of sheets
+#'
+#' @param path path to the xlsform
+#' 
+#' @importFrom readxl excel_sheets
+#' @importFrom stats setNames
+#'
+#' @noRd
+names_of_sheet <- function(path){
+  sheets <- excel_sheets(path)
+  if(all(sheets == get("names_sheets", envir = survey_designer))){
+    return(sheets)
+  } else {
+    stop("Problem with the name of sheets in the xls file used to load the referential")
+  }
+
+  # Read the xlsx file 
+  data <- lapply( sheets,  function(x){ read_xlsx(path = path, sheet = x)}) |>
+                  setNames(nm = sheets)
+
+  referential_type <- names(data$referential_type)
+  if(all(referential_type  %in% get("names_referential_type", envir = survey_designer)) ){
+    return(referential_type)
+  } else {
+    stop("Problem with the name of sheet for referential_type")
+  }
+
+  survey <- names(data$survey)
+  if(all(survey  %in% get("names_survey", envir = survey_designer)) ){
+    return(survey)
+  } else {
+    stop("Problem with the name of sheet for survey")
+  }
+
+  choices <- names(data$choices)
+  if(all(choices  %in% get("names_choices", envir = survey_designer)) ){
+    return(choices)
+  } else {
+    stop("Problem with the name of sheet for choices")
+  }
+
+  indicator <- names(data$indicator)
+  if(all(indicator  %in% get("names_indicator", envir = survey_designer)) ){
+    return(indicator)
+  } else {
+    stop("Problem with the name of sheet for indicator")
+  }
+
+  indicator_survey <- names(data$indicator_survey)
+  if(all(indicator_survey  %in% get("names_indicator_survey", envir = survey_designer)) ){
+    return(indicator_survey)
+  } else {
+    stop("Problem with the name of sheet for indicator_survey")
+  }
+
+  indicator_choices <- names(data$indicator_choices)
+  if(all(indicator_choices  %in% get("names_indicator_choices", envir = survey_designer)) ){
+    return(indicator_choices)
+  } else {
+    stop("Problem with the name of sheet for indicator_choices")
+  }
+
+  indicator_population <- names(data$indicator_population)
+  if(all(indicator_population  %in% get("names_indicator_population", envir = survey_designer)) ){
+    return(indicator_population)
+  } else {
+    stop("Problem with the name of sheet for indicator_population")
+  }
+
+  indicator_disaggregation <- names(data$indicator_disaggregation)
+  if(all(indicator_disaggregation  %in% get("names_indicator_disaggregation", envir = survey_designer)) ){
+    return(indicator_disaggregation)
+  } else {
+    stop("Problem with the name of sheet for indicator_disaggregation")
+  }
+}
+
+
+#' Get groups form begin and end into a list with data and information
+#' 
+#' @param data data from the survey sheet
+#'
+#' @importFrom purrr map2 set_names map
+#' @importFrom dplyr slice filter
+#' 
+#' @return list
+#' 
+get_groups <- function(data){
+  # only on survey
+  begin_start <- grep(x = data[["type"]], "begin_")
+  end_stop <- grep(x = data[["type"]], "end_")
+
+  if(length(begin_start) != length(end_stop)){
+    stop("Miss one begin or stop in the data")
+  }
+
+  if(!all(begin_start < end_stop)){
+    stop("One begin is before a end")
+  }
+
+  by_begin_end <- map2(begin_start, end_stop,
+                              function(x,y){
+
+                                data_to_get <- data %>% 
+                                  slice(x:y)
+                                by_groups <- list(data = data_to_get %>%
+                                                    filter(!type %in% c("begin_group", "end_group")),
+                                                  information = data_to_get %>%
+                                                    filter(type %in% c("begin_group", "end_group"))
+                                )
+                                # names(by_groups) <- by_groups[["information"]][["name"]]
+
+                                by_groups
+                              }) %>% 
+  purrr::set_names(nm = purrr::map(., ~ .x[["information"]][["name"]][1]))
+
+ return(by_begin_end)
+}
+
+#' Get choices for one question
+#'
+#' @param survey data from the choices sheet
+#' @param full_name the full name (i.e. concatenating groups) for the variable
+#'
+#' @importFrom dplyr filter select contains
+#'
+#' @return a data.frame to join
+get_choices_for_question <- function(survey, full_name){
+  survey %>% 
+    filter(list_name == full_name) %>% 
+    select(list_name, name, label)
+}
+
+#' function to find if we manipulate a xlsform
+#'
+#' @param data data of the survey
+#'
+#' @noRd
+
+
+contains_groups <- function(data){
+  any(grepl(x = data[["type"]], pattern = 'begin_group|begin_repeat|end_group|end_repeat'))
+}
+
+

dev/flat_mod_home.Rmd → dev/flat_modules_golem.Rmd

@@ -1,5 +1,5 @@
 ---
-title: "flat_mod_home.Rmd empty"
+title: "Golem Modules for Survey Designer"
 output: html_document
 editor_options: 
   chunk_output_type: console
@@ -65,6 +65,6 @@ test_that("mod_home works", {
 ```{r development-inflate, eval=FALSE}
 # Run but keep eval=FALSE to avoid infinite loop
 # Execute in the console directly
-fusen::inflate(flat_file = "dev/flat_mod_home.Rmd", vignette_name = "Mon module home")
+fusen::inflate(flat_file = "dev/flat_modules_golem", vignette_name = "Golem Modules for Survey Designer")
 ```