diff --git a/.Rbuildignore b/.Rbuildignore index 00858d7..d4e9d78 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,5 +10,8 @@ $run_dev.* ^\.github$ ^surveyDesigner\.Rproj$ ^docs$ +<<<<<<< HEAD ^app\.R$ +======= +>>>>>>> 5d46f08550c1eb5c6e5e288d470fff79faa8a585 ^rsconnect$ diff --git a/R/get_groups.R b/R/get_groups.R index 9749364..94f5819 100644 --- a/R/get_groups.R +++ b/R/get_groups.R @@ -80,6 +80,7 @@ get_choices_for_question <- function(survey, full_name){ #' #' @noRd + contains_groups <- function(data){ any(grepl(x = data[["type"]], pattern = 'begin_group|begin_repeat|end_group|end_repeat')) } diff --git a/R/globals.R b/R/globals.R index 38811e1..2dd42b2 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,6 +1,6 @@ globalVariables(unique(c( # get_choices_for_question: - "list_name", "name", + "list_name", "name", "label", # get_groups: ".", # get_groups : : diff --git a/R/referential.R b/R/referential.R index 801127b..48bff69 100644 --- a/R/referential.R +++ b/R/referential.R @@ -39,8 +39,9 @@ Referential <- R6::R6Class(classname = "Referential", # TODO checking survey and other sheets # survey have to be a xlsform + if(!contains_groups(data$survey)){ - stop("the sheet 'survey' doesn't includes groups") + stop("the sheet 'survey' doesn't includes groups - i.e. questions organised as module") } self$data <- data diff --git a/dev/flat_r6_referential.Rmd b/dev/flat_r6_referential.Rmd index e89513e..494004a 100644 --- a/dev/flat_r6_referential.Rmd +++ b/dev/flat_r6_referential.Rmd @@ -55,8 +55,9 @@ Referential <- R6::R6Class(classname = "Referential", # TODO checking survey and other sheets # survey have to be a xlsform + if(!contains_groups(data$survey)){ - stop("the sheet 'survey' doesn't includes groups") + stop("the sheet 'survey' doesn't includes groups - i.e. questions organised as module") } self$data <- data @@ -128,42 +129,6 @@ test_that("r6_referential works", { # Utils for referential manipulation -```{r development-utils, eval = FALSE} - -data <- ref$data$survey - -begin_start <- grep(x = , "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 <- purrr::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])) - - -``` - ```{r function-utils_xlsform} survey_designer <- new.env() @@ -246,6 +211,7 @@ get_choices_for_question <- function(survey, full_name){ #' #' @noRd + contains_groups <- function(data){ any(grepl(x = data[["type"]], pattern = 'begin_group|begin_repeat|end_group|end_repeat')) } @@ -264,6 +230,44 @@ names_of_sheet <- function(path){ } } ``` + + +```{r development-utils, eval = FALSE} + +data <- ref$data$survey + +begin_start <- grep(x = , "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 <- purrr::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])) + + +``` + ```{r tests-utils_xlsform} @@ -281,9 +285,9 @@ expect_type(result, "list") expect_true(inherits(get_choices_for_question, "function")) -get_chocies <- get_choices_for_question(ref$data$choices, "pop_groups", "English") +get_choices <- get_choices_for_question(ref$data$choices, "pop_groups") -expect_type(get_chocies, "list") +expect_type(get_choices, "list") }) ``` diff --git a/inst/SurveyDesigner_Referential.xlsx b/inst/SurveyDesigner_Referential.xlsx index b4afc25..032a153 100644 Binary files a/inst/SurveyDesigner_Referential.xlsx and b/inst/SurveyDesigner_Referential.xlsx differ diff --git a/tests/testthat/test-get_groups.R b/tests/testthat/test-get_groups.R index dcfb7ff..dc1dcce 100644 --- a/tests/testthat/test-get_groups.R +++ b/tests/testthat/test-get_groups.R @@ -14,8 +14,8 @@ expect_type(result, "list") expect_true(inherits(get_choices_for_question, "function")) -get_chocies <- get_choices_for_question(ref$data$choices, "pop_groups", "English") +get_choices <- get_choices_for_question(ref$data$choices, "pop_groups") -expect_type(get_chocies, "list") +expect_type(get_choices, "list") }) diff --git a/vignettes/class-r6-for-the-referencial.Rmd b/vignettes/class-r6-for-the-referencial.Rmd deleted file mode 100644 index 2405b0c..0000000 --- a/vignettes/class-r6-for-the-referencial.Rmd +++ /dev/null @@ -1,48 +0,0 @@ ---- -title: "Class R6 for the referencial" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{class-r6-for-the-referencial} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -```{r setup} -library(surveyDesigner) -``` - - - -# r6_referential - -With XlsForm, we can not filter as we want because the order inside the file is important. For me the first thing to do is to separate our file with begin and end group - - -```{r examples-r6_referential} -ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") -) - -head(ref$data$survey) - -# Example by groups -ref$by_groups$group_intro -``` - -# Utils for xlsx - - - - - - - - - diff --git a/vignettes/class-r6-for-the-referential.Rmd b/vignettes/class-r6-for-the-referential.Rmd index c50518c..a21a6cb 100644 --- a/vignettes/class-r6-for-the-referential.Rmd +++ b/vignettes/class-r6-for-the-referential.Rmd @@ -42,6 +42,10 @@ ref$by_groups$group_intro + + + + diff --git a/vignettes/mon-module-home.Rmd b/vignettes/mon-module-home.Rmd deleted file mode 100644 index 8b5ac3b..0000000 --- a/vignettes/mon-module-home.Rmd +++ /dev/null @@ -1,28 +0,0 @@ ---- -title: "Mon module home" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{mon-module-home} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -```{r setup} -library(surveyDesigner) -``` - - - -# mod_home - -```{r examples-mod_home} - -``` -