report2_compact.Rmd

---
author: ""
date: "`r format(Sys.time(), '%d %B, %Y')`"
output: word_document
params:
  file:
    value: NA
---

```{r setup, include = FALSE}
# Packages needed ----
library(readxl)
library(stringr)
library(flextable)
library(ftExtra)
library(tidyverse)
library(knitr)
library(rmarkdown)


# Setting the flextable defaults -> this formats the tables
set_flextable_defaults(font.family  = "Calibri",
                       border.color = "black",  
                       font.size    = 9, 
                       theme_fun    = "theme_vanilla",
                       big.mark     = ",", 
                       table.layout = "autofit")

# Loading the form(s) i.e:
  # 1) Questions (For questions - keeps the markdown formatting)
  # 2) Choices (For choices)
  # 3) Settings (For the Document title via the 'Settings' sheet)

survey_questions <- read_excel(params$file, sheet = "survey")

survey_choices   <- read_excel(params$file, sheet = "choices")

title            <- read_excel(params$file, sheet = "settings")

# Title is determined by the FORM TITLE in the SETTINGS sheet
title <- title$form_title

# dropping blanks
survey_choices   <- survey_choices |>
  filter(!is.na(list_name))

survey_questions <- survey_questions |>
  filter(!is.na(label))

# removing extra space from between the question and the list_name
survey_questions <- 
  survey_questions |>
  mutate(type  = gsub(pattern = "\\s+", 
                      replacement = " ", 
                      x = type))


# if numeric, we add square brackets around the value, if not, leave as is.
  survey_choices <- survey_choices |>
    mutate(name  = paste("[", name, "]",
                         sep = "")) |>
    mutate(label = paste(name, label,
                         sep = " "))

survey_choices <- survey_choices |> 
  group_by(list_name) |> 
  mutate(new_list = paste(label, 
                          collapse="\n")) |> 
  group_by(list_name) |>
  mutate(id = row_number()) |>
  mutate(new_list  = ifelse(test = id == 1,
                            yes  = new_list,
                            no   = NA)) |>
  subset(!is.na(new_list))

## Splitting the question column and stripping all the HTML code ----
survey_questions <-
  survey_questions |>
  separate(col  = type,
           into = c("type", 
                    "list_name"),
           sep  = " ") |>
  mutate(label  = gsub("#", "", label)) |>
  mutate(label  = gsub("@", "[at]", label)) |>
  mutate(label  = gsub("<(.|\n)*?>", "", label)) |>
  mutate(label  = gsub("\\*", "", label))


groups <- 
  survey_questions |>
  subset(type == "begin_group") |>
  mutate(list_name = name) |>
  select(list_name)

group_names <- as.vector(groups$list_name)

                  

  


# all question types that dont require a list per say
types <-  c("integer",
            "decimal",
            "range",
            "text",
            "rank ",
            "note",
            "geopoint",
            "geotrace",
            "geoshape",
            "date",
            "time",
            "dateTime",
            "image",
            "audio",
            "background-audio",
            "video",
            "file",
            "barcode",
            "calculate",
            "acknowledge",
            "hidden",
            "xml-external"
)

survey_questions$list_name <-
  ifelse(
    survey_questions$type %in% types,
    yes = survey_questions$type,
    no  = survey_questions$list_name)

survey_choices <- as.data.frame(survey_choices) 

# adding these to the choice sheet
survey_choices <- survey_choices %>%
  add_row(
    list_name = c("integer",
                  "decimal",
                  "range",
                  "text",
                  "note",
                  "geopoint",
                  "geotrace",
                  "geoshape",
                  "date",
                  "time",
                  "dateTime",
                  "image",
                  "audio",
                  "background-audio",
                  "video",
                  "file",
                  "barcode",
                  "calculate",
                  "acknowledge",
                  "hidden",
                  "xml-external"),
    label     = c("[Integer]",
                  "[Decimal]",
                  "[Range]",
                  "[Text]",
                  "[Enumerator Note]",
                  "[Lat, Long, Alt]",
                  "[Lat, Long, Alt]",
                  "[Lat, Long, Alt]",
                  "[Date]",
                  "[Time]",
                  "[Date + Time]",
                  "[Image]",
                  "[Audio]",
                  "[Background Audio]",
                  "[Video]",
                  "[File]",
                  "[Barcode/QR Code]",
                  "[Calculation]",
                  "[Acknowledge]",
                  "[Hidden]",
                  "[XML External]"
    )
  )

survey_choices <- survey_choices %>%
  add_row(
    list_name = c(group_names))

survey_questions <- survey_questions |>
  mutate(list_name = ifelse(test = type == "begin_group", 
                            yes = name, 
                            no = list_name))

## Merging choices & questions via the choice label ----
survey_questions <- survey_questions |>
  inner_join(x  = survey_questions,
             y  = survey_choices,
             by = "list_name")

survey_questions <- survey_questions |>
  mutate(label.y = ifelse(test = type == "begin_group", 
                          yes = label.x, 
                          no = label.y))

survey_questions <- 
  survey_questions |>
  mutate(new_list = ifelse(test = is.na(new_list), 
                          yes = label.y, 
                          no = new_list))



# some more cleaning for the forms
survey_questions <- survey_questions  |>
  group_by(name.x) |>
  mutate(id = row_number()) |>
  mutate(label.x  = ifelse(test = id == 1,
                           yes  = label.x,
                           no   = NA))



survey_questions <- survey_questions|>
  select(name.x, 
         label.x, 
         new_list) |>
  rename(Variable = name.x)

# need to correct column labels
survey_questions <- survey_questions|>
  rename(Question = label.x,
         Choices  = new_list) |>
  mutate(Question = replace_na(Question, " ")) |>
  select(Variable, 
         Question, 
         Choices)

# final table to be printed
final <- subset(survey_questions, 
                select = c("Variable", 
                           "Question", 
                           "Choices"))


final <- final |>
  mutate(test_section = str_detect(Choices, "\\[", negate = TRUE)) |>
  mutate(Choices = ifelse(test = test_section == TRUE, 
                          yes = NA,
                          no = Choices)) |>
  mutate(Variable = ifelse(test = test_section == TRUE, 
                          yes = "Section Name",
                          no = Variable)) |>
  mutate(Choices = replace_na(Choices, "")) |>
  select(-test_section)


rm(survey_choices, survey_questions)

```


---
title: "`r title`"
---


```{r ft.split = TRUE, echo = F}
  final <- 
  final |>
  flextable() |>
  set_caption(caption = "Questionnaire",
              style   = "Table Caption")

# formatting the table
final <- bg(final, 
           bg      =            "white", 
           part    =            "header")
final <- bg(final, 
           i       = ~ Variable == "Section Name", 
           bg      =            "#345A8A", 
           part    =            "body")
final <- color(final, 
              i    = ~ Variable == "Section Name", 
           color   = "white", 
           part    = "body")

final <- bold(final,  
              ~ !is.na(Question), 
              c(1:2))

final <-  italic(final, 
                 ~ !is.na(Question), 1)

final <- color(final, 
              ~ !is.na(Question) & Variable!="Section Name", 
              1, 
              part  = "body", 
              color = "blue")

final

```