Skip to content

Commit

Permalink
Merge branch '11-as-dev-i-would-like-to-wireframe-the-ui-in-order-to-…
Browse files Browse the repository at this point in the history
…give-preview-and-create-engagement' of https://github.com/unhcr-americas/surveyDesigner into 11-as-dev-i-would-like-to-wireframe-the-ui-in-order-to-give-preview-and-create-engagement
  • Loading branch information
Edouard-Legoupil committed Apr 26, 2023
2 parents 9d7cea4 + 0237925 commit 534cd6a
Show file tree
Hide file tree
Showing 17 changed files with 312 additions and 151 deletions.
3 changes: 3 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -10,5 +10,8 @@ $run_dev.*
^\.github$
^surveyDesigner\.Rproj$
^docs$
<<<<<<< HEAD
^app\.R$
=======
>>>>>>> 5d46f08550c1eb5c6e5e288d470fff79faa8a585
^rsconnect$
2 changes: 1 addition & 1 deletion .github/ISSUE_TEMPLATE/Template issue.md
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
---
name: Standard Issue EN
about: Use this template to create a new issue.
title: "ETQ <user/dev/...>, I would like to ... in order to ..."
title: "As <user/dev/...>, I would like to ... in order to ..."
---

<!-- This part should be helping to understand why is this issue important. What is the final objective ? -->
Expand Down
27 changes: 13 additions & 14 deletions .github/template_commit
Original file line number Diff line number Diff line change
@@ -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

Expand All @@ -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
#
Expand Down
30 changes: 15 additions & 15 deletions R/get_groups.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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'))
}

Expand Down
2 changes: 1 addition & 1 deletion R/globals.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
globalVariables(unique(c(
# get_choices_for_question:
"list_name", "name",
"list_name", "name", "label",
# get_groups:
".",
# get_groups : <anonymous>:
Expand Down
13 changes: 7 additions & 6 deletions R/referential.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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),
Expand Down
177 changes: 177 additions & 0 deletions dev/flat_r6_questionnaire.Rmd
Original file line number Diff line number Diff line change
@@ -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"
)
```

Loading

0 comments on commit 534cd6a

Please sign in to comment.