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/.github/ISSUE_TEMPLATE/Template issue.md b/.github/ISSUE_TEMPLATE/Template issue.md index 2170907..0eb454d 100644 --- a/.github/ISSUE_TEMPLATE/Template issue.md +++ b/.github/ISSUE_TEMPLATE/Template issue.md @@ -1,7 +1,7 @@ --- name: Standard Issue EN about: Use this template to create a new issue. -title: "ETQ , I would like to ... in order to ..." +title: "As , I would like to ... in order to ..." --- diff --git a/.github/template_commit b/.github/template_commit index dcad5c7..a3f6552 100644 --- a/.github/template_commit +++ b/.github/template_commit @@ -1,5 +1,16 @@ -# Define a direct explicite title with main tag -# Example: feat: Create my_fun to build xml +# Define a direct explicit title with main tag +# Explication for tags: +# [ci] : everything related to ci, even the ci fix for the moment +# [fix] : fix a bug in the code base +# [feat] : the addition of a new feature +# [doc]: package doc, we should see that on these 3 days roughly +# [test]: for unit tests +# [refactor] : Refactoring of code, like factoring, moving code +# [style]: for code formatting, tabulation, ... +# [chore]: everything that touches the project itself, classic background tasks, like a version upgrade + + +# Example: [feat]: Create my_fun to build xml # 50-character subject line # Add an empty line after that title @@ -25,21 +36,9 @@ Issues issue # -# Explication for tags: -# ci : everything related to ci, even the ci fix for the moment -# fix : fix a bug in the code base -# feat : the addition of a new feature -# doc: package doc, we should see that on these 3 days roughly -# test: for unit tests -# refactor : Refactoring of code, like factoring, moving code -# style: for code formatting, tabulation, ... -# chore: everything that touches the project itself, classic background tasks, like a version upgrade # Exemple of commit # [feat]: a wonderful new feature - part 1 - -# Exemple of commit -# feat: a wonderful new feature - part 1 # # tags: feat, doc, test # diff --git a/R/get_groups.R b/R/get_groups.R index 3034994..94f5819 100644 --- a/R/get_groups.R +++ b/R/get_groups.R @@ -4,21 +4,21 @@ survey_designer <- new.env() assign( "names_sheets", - c("survey", + c("referential_type", + "survey", "choices", - "Indicator", - "Indicator_survey", - "indicator_choices", + "indicator", + "indicator_survey", + "indicator_choices", "indicator_population", - "indicator_dissagregation", - "country_language" + "indicator_disaggregation" ), envir = survey_designer) #' Get groups form begin and end into a list with data and information #' -#' @param data data form the survey sheet +#' @param data data from the survey sheet #' #' @importFrom purrr map2 set_names map #' @importFrom dplyr slice filter @@ -62,17 +62,16 @@ by_begin_end <- map2(begin_start, end_stop, #' Get choices for one question #' -#' @param data data of choices -#' @param indicator the name of the indicator for the question -#' @param lg language to use +#' @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(data, indicator, lg){ - data %>% - filter(list_name == indicator) %>% - select(list_name, name, contains(lg)) +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 @@ -81,7 +80,8 @@ get_choices_for_question <- function(data, indicator, lg){ #' #' @noRd -is_a_xlsfrom <- function(data){ + +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 1ac1846..48bff69 100644 --- a/R/referential.R +++ b/R/referential.R @@ -9,14 +9,14 @@ Referential <- R6::R6Class(classname = "Referential", public = list( #' @description #' read the xlsx for each sheet and return a named list - #' @param path path to the xlsForm + #' @param path path to the file with the full referential #' #' @importFrom readxl excel_sheets read_xlsx #' #' @return named list #' @examples #' ref <- Referential$new( -#' path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") +#' path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") #' ) #' #' head(ref$data$survey) @@ -39,8 +39,9 @@ Referential <- R6::R6Class(classname = "Referential", # TODO checking survey and other sheets # survey have to be a xlsform - if(!is_a_xlsfrom(data$survey)){ - stop("the sheet 'survey' dosen't seem to be a xlsform") + + if(!contains_groups(data$survey)){ + stop("the sheet 'survey' doesn't includes groups - i.e. questions organised as module") } self$data <- data @@ -49,9 +50,9 @@ Referential <- R6::R6Class(classname = "Referential", self$get_groups() }, - #' @field data named list for the xlsx file + #' @field data named list for the referential file data = list(), - #' @field by_groups survey data separate by begin and end to manipulate data + #' @field by_groups survey modules separated by begin and end to manipulate data by_groups = list(), #' @field path path for the xlsx file path = character(0), diff --git a/dev/flat_r6_questionnaire.Rmd b/dev/flat_r6_questionnaire.Rmd new file mode 100644 index 0000000..d7bc4c0 --- /dev/null +++ b/dev/flat_r6_questionnaire.Rmd @@ -0,0 +1,177 @@ +--- +title: "questionnaire Object" +output: html_document +editor_options: + chunk_output_type: console +--- + +```{r development, include=FALSE} +library(testthat) +``` + +```{r development-load} +# Load already included functions if relevant +pkgload::load_all(export_all = FALSE) +library(readxl) +library(dplyr) +library(purrr) + +``` + +# r6_Questionnaire + + +A questionnaire is created a list of one or multiple [XlsForm](http://xlsform.org) + +```{r function-r6_questionnaire} +#' questionnaire class is a class to load, check and manipulate one or more than one XLSForm +#' @importFrom R6 R6Class +#' +#' @export + +questionnaire <- R6::R6Class(classname = "questionnaire", + public = list( + #' @description + #' read the xlsx for each sheet and return a named list + #' @param path path to the xlsForm + #' + #' @importFrom readxl excel_sheets read_xlsx + #' + #' @return named list + initialize = function(path){ + # Define path + self$path <- path + + # Get sheets of xlsx + sheets <- names_of_sheet(path) + + # Read the xlsx file + data <- lapply( + sheets, + function(x){ + read_xlsx(path = path, sheet = x)}) |> + setNames(nm = sheets) + # TODO checking survey and other sheets + + # survey have to be a xlsform + if(!is_a_xlsfrom(data$survey)){ + stop("the sheet 'survey' dosen't seem to be a xlsform") + } + + self$data <- data + + # Get groups + + self$get_groups() + } + ), + private = list( + + ) +) +``` + +```{r development-test} +ref <- questionnaire$new( + path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") +) +``` + + +```{r examples-r6_questionnaire} +ref <- questionnaire$new( + path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") +) + +head(ref$data$survey) + +# Example by groups +ref$by_groups$group_intro +``` + +```{r tests-r6_questionnaire} +test_that("r6_questionnaire works", { + ref <- questionnaire$new( + path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + ) + + expect_true( inherits(ref, "R6") ) + + expect_error( + questionnaire$new( + path = "not_good_sheet.xlsx" + ) + ) + + expect_error( + questionnaire$new( + path = "wt_xlsform_in_survey.xlsx" + ) + ) + +}) +``` + + +# Utils for xlsx + +```{r development-utils, eval = FALSE} + + + + +``` + + +```{r function-utils_xlsform} +survey_designer <- new.env() + +assign( + "names_sheets", + c("survey", + "choices", + "Indicator", + "Indicator_survey", + "indicator_choices", + "indicator_population", + "indicator_dissagregation", + "country_language" + ), + envir = survey_designer) + + + + +#' 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") + } +} +``` + + +```{r tests-utils_xlsform} +test_that("utils_xlsform 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_r6_questionnaire.Rmd", + vignette_name = "Class R6 for the questionnaire" + ) +``` + diff --git a/dev/flat_r6_referential.Rmd b/dev/flat_r6_referential.Rmd index d7ee5ae..494004a 100644 --- a/dev/flat_r6_referential.Rmd +++ b/dev/flat_r6_referential.Rmd @@ -1,5 +1,5 @@ --- -title: "flat_r6_referential.Rmd empty" +title: "Class R6 for the referential" output: html_document editor_options: chunk_output_type: console @@ -20,7 +20,9 @@ library(purrr) # 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 +The filtering of the referential should take in account the order/sequence of questions and modules. + +A specific method is implemented to separate our file with begin and end group ```{r function-r6_referential} #' Referential class is a class to load, check and manipulate the XLSForm @@ -32,7 +34,7 @@ Referential <- R6::R6Class(classname = "Referential", public = list( #' @description #' read the xlsx for each sheet and return a named list - #' @param path path to the xlsForm + #' @param path path to the file with the full referential #' #' @importFrom readxl excel_sheets read_xlsx #' @@ -53,8 +55,9 @@ Referential <- R6::R6Class(classname = "Referential", # TODO checking survey and other sheets # survey have to be a xlsform - if(!is_a_xlsfrom(data$survey)){ - stop("the sheet 'survey' dosen't seem to be a xlsform") + + if(!contains_groups(data$survey)){ + stop("the sheet 'survey' doesn't includes groups - i.e. questions organised as module") } self$data <- data @@ -63,9 +66,9 @@ Referential <- R6::R6Class(classname = "Referential", self$get_groups() }, - #' @field data named list for the xlsx file + #' @field data named list for the referential file data = list(), - #' @field by_groups survey data separate by begin and end to manipulate data + #' @field by_groups survey modules separated by begin and end to manipulate data by_groups = list(), #' @field path path for the xlsx file path = character(0), @@ -84,14 +87,14 @@ Referential <- R6::R6Class(classname = "Referential", ```{r development-test} ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) ``` ```{r examples-r6_referential} ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) head(ref$data$survey) @@ -103,7 +106,7 @@ ref$by_groups$group_intro ```{r tests-r6_referential} test_that("r6_referential works", { ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) expect_true( inherits(ref, "R6") ) @@ -124,65 +127,29 @@ test_that("r6_referential works", { ``` -# Utils for xlsx +# 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() assign( "names_sheets", - c("survey", + c("referential_type", + "survey", "choices", - "Indicator", - "Indicator_survey", - "indicator_choices", + "indicator", + "indicator_survey", + "indicator_choices", "indicator_population", - "indicator_dissagregation", - "country_language" + "indicator_disaggregation" ), envir = survey_designer) #' Get groups form begin and end into a list with data and information #' -#' @param data data form the survey sheet +#' @param data data from the survey sheet #' #' @importFrom purrr map2 set_names map #' @importFrom dplyr slice filter @@ -226,17 +193,16 @@ by_begin_end <- map2(begin_start, end_stop, #' Get choices for one question #' -#' @param data data of choices -#' @param indicator the name of the indicator for the question -#' @param lg language to use +#' @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(data, indicator, lg){ - data %>% - filter(list_name == indicator) %>% - select(list_name, name, contains(lg)) +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 @@ -245,7 +211,8 @@ get_choices_for_question <- function(data, indicator, lg){ #' #' @noRd -is_a_xlsfrom <- function(data){ + +contains_groups <- function(data){ any(grepl(x = data[["type"]], pattern = 'begin_group|begin_repeat|end_group|end_repeat')) } @@ -263,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} @@ -270,7 +275,7 @@ test_that("utils_xlsform works", { expect_true(inherits(get_groups, "function")) ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) result <- get_groups(ref$data$survey) @@ -280,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") }) ``` @@ -293,7 +298,7 @@ expect_type(get_chocies, "list") # Execute in the console directly fusen::inflate( flat_file = "dev/flat_r6_referential.Rmd", - vignette_name = "Class R6 for the referencial" + vignette_name = "Class R6 for the referential" ) ``` diff --git a/inst/SurveyDesigner_Referential.xlsx b/inst/SurveyDesigner_Referential.xlsx new file mode 100644 index 0000000..032a153 Binary files /dev/null and b/inst/SurveyDesigner_Referential.xlsx differ diff --git a/inst/household_survey_americas.xlsx b/inst/household_survey_americas.xlsx deleted file mode 100644 index 366dad6..0000000 Binary files a/inst/household_survey_americas.xlsx and /dev/null differ diff --git a/man/Referential.Rd b/man/Referential.Rd index 21f57e5..dcd4a80 100644 --- a/man/Referential.Rd +++ b/man/Referential.Rd @@ -15,7 +15,7 @@ Referential class is a class to load, check and manipulate the XLSForm ## ------------------------------------------------ ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) head(ref$data$survey) @@ -26,9 +26,9 @@ ref$by_groups$group_intro \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{data}}{named list for the xlsx file} +\item{\code{data}}{named list for the referential file} -\item{\code{by_groups}}{survey data separate by begin and end to manipulate data} +\item{\code{by_groups}}{survey modules separated by begin and end to manipulate data} \item{\code{path}}{path for the xlsx file} } @@ -54,7 +54,7 @@ read the xlsx for each sheet and return a named list \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{path}}{path to the xlsForm} +\item{\code{path}}{path to the file with the full referential} } \if{html}{\out{
}} } @@ -64,7 +64,7 @@ named list \subsection{Examples}{ \if{html}{\out{
}} \preformatted{ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) head(ref$data$survey) diff --git a/man/get_choices_for_question.Rd b/man/get_choices_for_question.Rd index d708799..9b4cbc0 100644 --- a/man/get_choices_for_question.Rd +++ b/man/get_choices_for_question.Rd @@ -4,14 +4,12 @@ \alias{get_choices_for_question} \title{Get choices for one question} \usage{ -get_choices_for_question(data, indicator, lg) +get_choices_for_question(survey, full_name) } \arguments{ -\item{data}{data of choices} +\item{survey}{data from the choices sheet} -\item{indicator}{the name of the indicator for the question} - -\item{lg}{language to use} +\item{full_name}{the full name (i.e. concatenating groups) for the variable} } \value{ a data.frame to join diff --git a/man/get_groups.Rd b/man/get_groups.Rd index 8ac2553..4fcb1ce 100644 --- a/man/get_groups.Rd +++ b/man/get_groups.Rd @@ -7,7 +7,7 @@ get_groups(data) } \arguments{ -\item{data}{data form the survey sheet} +\item{data}{data from the survey sheet} } \value{ list diff --git a/tests/testthat/test-get_groups.R b/tests/testthat/test-get_groups.R index 370bcda..dc1dcce 100644 --- a/tests/testthat/test-get_groups.R +++ b/tests/testthat/test-get_groups.R @@ -4,7 +4,7 @@ test_that("utils_xlsform works", { expect_true(inherits(get_groups, "function")) ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) result <- get_groups(ref$data$survey) @@ -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/tests/testthat/test-referential.R b/tests/testthat/test-referential.R index 5c88b1c..475e45b 100644 --- a/tests/testthat/test-referential.R +++ b/tests/testthat/test-referential.R @@ -2,7 +2,7 @@ test_that("r6_referential works", { ref <- Referential$new( - path = system.file("household_survey_americas.xlsx", package = "surveyDesigner") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) expect_true( inherits(ref, "R6") ) diff --git a/vignettes/class-r6-for-the-referencial.Rmd b/vignettes/class-r6-for-the-referential.Rmd similarity index 57% rename from vignettes/class-r6-for-the-referencial.Rmd rename to vignettes/class-r6-for-the-referential.Rmd index 2405b0c..a21a6cb 100644 --- a/vignettes/class-r6-for-the-referencial.Rmd +++ b/vignettes/class-r6-for-the-referential.Rmd @@ -1,8 +1,8 @@ --- -title: "Class R6 for the referencial" +title: "Class R6 for the referential" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{class-r6-for-the-referencial} + %\VignetteIndexEntry{class-r6-for-the-referential} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- @@ -22,12 +22,14 @@ 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 +The filtering of the referential should take in account the order/sequence of questions and modules. + +A specific method is implemented 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") + path = system.file("SurveyDesigner_Referential.xlsx", package = "surveyDesigner") ) head(ref$data$survey) @@ -36,10 +38,14 @@ head(ref$data$survey) ref$by_groups$group_intro ``` -# Utils for xlsx +# Utils for referential manipulation + + + + 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} - -``` -