R/get_groups.R

In unhcr-americas/surveyDesigner: A Shiny App to help in the survey integration process

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


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

#' function to check name of sheets
#'
#' @param path path to the xlsform
#'
#' @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")
  }
}