Merge pull request #134 from NIFU-NO/dev

Dev

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: saros.base
 Title: Base Tools for Semi-Automatic Reporting of Ordinary Surveys
-Version: 0.2.9
+Version: 0.3.2
 Authors@R: c(
     person(given = "Stephan", 
            family = "Daus", 

R/add_max_chars_labels_to_chapter_structure.R

@@ -0,0 +1,11 @@
+add_max_chars_labels_to_chapter_structure <-
+  function(chapter_structure,
+           target_variable = ".variable_label_suffix_dep",
+           variable_name_max_label_char = ".max_chars_labels_dep") {
+    if (is.null(chapter_structure[[target_variable]])) {
+      cli::cli_abort("{.arg target_variable} ({.var {target_variable}}) not found in {.arg chapter_structure}.")
+    }
+
+    chapter_structure |>
+      dplyr::mutate("{variable_name_max_label_char}" := max(c(nchar(.data[[target_variable]]), 0), na.rm = TRUE))
+  }

R/add_n_cats_to_chapter_structure.R

@@ -3,33 +3,37 @@ add_n_cats_to_chapter_structure <-
            data,
            target_variable = ".variable_name_dep",
            variable_name_n_cats = ".n_cats_dep",
-           variable_name_max_cat_char = ".max_chars_dep",
+           variable_name_max_label_char = ".max_chars_labels_dep",
+           variable_name_max_cat_char = ".max_chars_cats_dep",
            drop_na = TRUE) {
-
-    if(is.null(chapter_structure[[target_variable]])) {
+    if (is.null(chapter_structure[[target_variable]])) {
       cli::cli_abort("{.arg target_variable} ({.var {target_variable}}) not found in {.arg chapter_structure}.")
     }
 
     chapter_structure |>
-    dplyr::group_map(.keep = TRUE,
-        .f = ~{
-          if(all(!is.na(as.character(.x[[target_variable]])))) {
-
+      dplyr::group_map(
+        .keep = TRUE,
+        .f = ~ {
+          if (all(!is.na(as.character(.x[[target_variable]])))) {
             out <-
               get_common_levels(data, col_pos = as.character(.x[[target_variable]]))
-            if(isTRUE(drop_na)) out <- out[!is.na(out)]
+            if (isTRUE(drop_na)) out <- out[!is.na(out)]
 
             .x[[variable_name_n_cats]] <- length(out)
-            if(is.na(length(out))) {
+            if (is.na(length(out))) {
               .x[[variable_name_n_cats]] <- 0
-            } else .x[[variable_name_n_cats]] <- length(out)
-            if(is.na(max(nchar(out), na.rm=TRUE))) {
+            } else {
+              .x[[variable_name_n_cats]] <- length(out)
+            }
+            if (is.na(max(nchar(out), na.rm = TRUE))) {
               .x[[variable_name_max_cat_char]] <- 0
-            } else .x[[variable_name_max_cat_char]] <- max(nchar(out), na.rm=TRUE)
+            } else {
+              .x[[variable_name_max_cat_char]] <- max(nchar(out), na.rm = TRUE)
+            }
           }
           .x
-        }) |>
+        }
+      ) |>
       dplyr::bind_rows() |>
       dplyr::group_by(dplyr::pick(tidyselect::all_of(dplyr::group_vars(chapter_structure))))
-
   }

R/collapse_chapter_structure_to_chr.R

@@ -1,11 +1,11 @@
-collapse_chapter_structure_to_chr <- function(data, sep=",", sep2=",", last=",", trunc = 30) {
+collapse_chapter_structure_to_chr <- function(data, sep = ",", sep2 = ",", last = ",", trunc = 35) {
   data |>
     dplyr::distinct(dplyr::pick(tidyselect::everything())) |>
-  lapply(FUN = function(col) {
-    col <- as.character(col)
-    uniques <- unique(col)
-    uniques <- uniques[!is.na(uniques)]
-    cli::ansi_collapse(uniques, sep=sep, sep2 = sep2, last = last, trunc = trunc, width = Inf)
-  }) |>
+    lapply(FUN = function(col) {
+      col <- as.character(col)
+      uniques <- unique(col)
+      uniques <- uniques[!is.na(uniques)]
+      cli::ansi_collapse(uniques, sep = sep, sep2 = sep2, last = last, trunc = trunc, width = Inf)
+    }) |>
     unlist()
 }

R/download_zip_to_folder.R

@@ -44,6 +44,7 @@ download_zip_to_folder <-
     new_files <- fs::dir_ls(folder_in_temp_path, recurse = TRUE, type = "file", all = TRUE)
     new_files <- gsub(x = new_files, pattern = folder_in_temp_path, replacement = "")
     new_files <- gsub(x = new_files, pattern = "^/", replacement = "")
+    dir.create(out_path, showWarnings = FALSE, recursive = TRUE)
     old_files <- fs::dir_ls(out_path, recurse = TRUE, type = "file", all = TRUE)
     old_files <- gsub(x = old_files, pattern = out_path, replacement = "")
     old_files <- gsub(x = old_files, pattern = "^/", replacement = "")

R/gen_qmd_structure.R

@@ -5,47 +5,49 @@ gen_qmd_structure <-
            replace_heading_for_group = NULL,
            prefix_heading_for_group = NULL,
            suffix_heading_for_group = NULL) {
-
-
-
     gen_group_structure <- function(grouped_data,
-                                     level = 1,
-                                     grouping_structure) {
+                                    level = 1,
+                                    grouping_structure) {
       output <- character()
       new_out <- character()
 
-      if (level > ncol(grouped_data)) return(output)
+      if (level > ncol(grouped_data)) {
+        return(output)
+      }
 
 
-      for(value in unique(grouped_data[[level]])) {
-# if(!is.na(value) && value == "x1_sex") browser()
+      for (value in unique(grouped_data[[level]])) {
+        # if(!is.na(value) && value == "x1_sex") browser()
 
 
         # Keep only relevant part of meta data which will be forwarded into a deeper level
         sub_df <-
-          vctrs::vec_slice(grouped_data,
-                           is.na(as.character(grouped_data[[colnames(grouped_data)[level]]])) |
-                             as.character(grouped_data[[colnames(grouped_data)[level]]]) == value) |>
+          vctrs::vec_slice(
+            grouped_data,
+            # is.na(as.character(grouped_data[[colnames(grouped_data)[level]]])) |
+            as.character(grouped_data[[colnames(grouped_data)[level]]]) %in% value
+          ) |>
           droplevels()
 
 
         # Setting a specific sub-chapter (e.g. a label_prefix) as the column name to be able to forward filtering information to deeper recursion calls without additional complex arguments
         names(grouping_structure)[level] <- value
 
         # If innermost/deepest level, insert chunk
-        if(level == length(grouping_structure)) {
-
+        if (level == length(grouping_structure)) {
           # Create new metadata with bare minimum needed, and reapply grouping
           chapter_structure_section <-
-            prepare_chapter_structure_section(chapter_structure = chapter_structure,
-                                              grouping_structure = grouping_structure)
-
-          if(nrow(chapter_structure_section) >= 1) {
+            prepare_chapter_structure_section(
+              chapter_structure = chapter_structure,
+              grouping_structure = grouping_structure
+            )
 
+          if (nrow(chapter_structure_section) >= 1) {
             new_out <- # Might be character() (initialized) or string (character vector?)
-              insert_chunk(chapter_structure_section = chapter_structure_section,
-                           grouping_structure = unname(grouping_structure)
-                          )
+              insert_chunk(
+                chapter_structure_section = chapter_structure_section,
+                grouping_structure = unname(grouping_structure)
+              )
           }
         }
 
@@ -58,35 +60,43 @@ gen_qmd_structure <-
             ignore_heading_for_group = ignore_heading_for_group,
             replace_heading_for_group = replace_heading_for_group,
             prefix_heading_for_group = prefix_heading_for_group,
-            suffix_heading_for_group = suffix_heading_for_group)
+            suffix_heading_for_group = suffix_heading_for_group
+          )
 
 
         output <- attach_new_output_to_output( # Might be character() or a string
           output = output,
           heading_line = heading_line,
           new_out = new_out,
           level = level,
-          grouping_structure = grouping_structure)
+          grouping_structure = grouping_structure
+        )
 
         added <- # Recursive call
-          gen_group_structure(grouped_data = sub_df,
-                               level = level + 1,
-                               grouping_structure = grouping_structure) |>
-          stringi::stri_remove_empty_na()
+          gen_group_structure(
+            grouped_data = sub_df,
+            level = level + 1,
+            grouping_structure = grouping_structure
+          )
+        added <-
+          stringi::stri_remove_empty_na(added)
 
         output <-
           stringi::stri_c(output,
-                          added,
-                          sep="\n\n", ignore_null=TRUE) # Space between each section (before new heading)
+            added,
+            sep = "\n\n", ignore_null = TRUE
+          ) # Space between each section (before new heading)
         output <-
-          if(length(output)>0) output else ""
+          if (length(output) > 0) output else ""
       }
-      if(length(output)>1) browser()
-
-      if(length(output) != 1 || is.na(output)) {
-        cli::cli_abort(c("x"="Internal error in {.fn gen_qmd_structure}",
-                         "!" = "{.val output} is {output}",
-                       i="Please create a bug report at {.url https://github.com/NIFU-NO/saros.base/issues}."))
+      if (length(output) > 1) browser()
+
+      if (length(output) != 1 || is.na(output)) {
+        cli::cli_abort(c(
+          "x" = "Internal error in {.fn gen_qmd_structure}",
+          "!" = "{.val output} is {output}",
+          i = "Please create a bug report at {.url https://github.com/NIFU-NO/saros.base/issues}."
+        ))
       }
 
       return(output)
@@ -100,7 +110,9 @@ gen_qmd_structure <-
       dplyr::distinct(dplyr::pick(tidyselect::all_of(grouping_structure)))
 
     out <-
-      gen_group_structure(grouped_data = grouped_data,
-                           grouping_structure = grouping_structure)
+      gen_group_structure(
+        grouped_data = grouped_data,
+        grouping_structure = grouping_structure
+      )
     out
   }

R/refine_chapter_overview.R

@@ -384,7 +384,8 @@ refine_chapter_overview <-
             data = data,
             target_variable = ".variable_name_dep",
             variable_name_n_cats = ".n_cats_dep",
-            variable_name_max_cat_char = ".max_chars_dep",
+            variable_name_max_label_char = ".max_chars_labels_dep",
+            variable_name_max_cat_char = ".max_chars_cats_dep",
             drop_na = TRUE
           )
 
@@ -394,9 +395,24 @@ refine_chapter_overview <-
             data = data,
             target_variable = ".variable_name_indep",
             variable_name_n_cats = ".n_cats_indep",
-            variable_name_max_cat_char = ".max_chars_indep",
+            variable_name_max_label_char = ".max_chars_labels_indep",
+            variable_name_max_cat_char = ".max_chars_cats_indep",
             drop_na = TRUE
           )
+
+        out <-
+          add_max_chars_labels_to_chapter_structure(
+            chapter_structure = out,
+            target_variable = ".variable_label_suffix_dep",
+            variable_name_max_label_char = ".max_chars_labels_dep"
+          )
+
+        out <-
+          add_max_chars_labels_to_chapter_structure(
+            chapter_structure = out,
+            target_variable = ".variable_label_suffix_indep",
+            variable_name_max_label_char = ".max_chars_labels_indep"
+          )
       }
 
 

R/setup_mesos.R

@@ -68,18 +68,20 @@ create_mesos_stubs_from_main_files <- function(
         dplyr::rowwise() |>
         dplyr::mutate(
             main_file_no_ = stringi::stri_replace_first_regex(.data$main_file,
-                pattern = "^_", replacement = ""
+                pattern = "^_|\\.[r]qmd", replacement = ""
             ),
             new_file_path = fs::path(
                 .env$dir_path,
                 .data$mesos_group,
                 .data$main_file_no_
             ),
             contents = {
-                yaml <- list(params = list(
-                    mesos_var = .env$mesos_var,
-                    mesos_group = .data$mesos_group
-                ))
+                yaml <- list(
+                    params = list(
+                        mesos_var = .env$mesos_var,
+                        mesos_group = .data$mesos_group
+                    )
+                )
                 if (.data$main_file_no_ %in% main_files) {
                     yaml$title <- paste0(.data$mesos_group)
                 }

R/zzz.R

@@ -58,8 +58,7 @@ if (!exists(".saros.env")) .saros.env <- NULL
         "
 ::: {{#fig-{.chunk_name}}}
 
-```{{r}}
-#| fig-height: !expr fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_y={.max_chars_dep}, n_x={.n_indep}, n_cats_x={.n_cats_indep}, max_chars_x={.max_chars_indep})
+```{{r, fig.height=fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_cats_y={.max_chars_cats_dep}, max_chars_labels_y={.max_chars_labels_dep}, n_x={.n_indep}, n_cats_x={.n_cats_indep}, max_chars_cats_x={.max_chars_cats_indep}, max_chars_labels_x={.max_chars_labels_indep})}}
 {.obj_name} <- \n\tdata_{.chapter_foldername} |>\n\t\tmakeme(dep = c({.variable_name_dep}), \n\t\tindep = c({.variable_name_indep}), \n\t\ttype = 'cat_plot_html')
 nrange <- stringi::stri_c('N = ', n_range2({.obj_name}))
 link <- make_link(data = {.obj_name}$data)
@@ -83,8 +82,7 @@ _{.variable_label_prefix_dep}_ by _{tolower(.variable_label_prefix_indep)}_. `{{
         "
 ::: {{#fig-{.chunk_name}}}
 
-```{{r}}
-#| fig-height: !expr fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_y={.max_chars_dep})
+```{{r, fig.height=fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_labels_y={.max_chars_labels_dep}, max_chars_cats_y={.max_chars_cats_dep})}}
 {.obj_name} <- \n\tdata_{.chapter_foldername} |>\n\t\tmakeme(dep = c({.variable_name_dep}), \n\t\ttype = 'cat_plot_html')
 nrange <- stringi::stri_c('N = ', n_range2({.obj_name}))
 link <- make_link(data = {.obj_name}$data)
@@ -415,8 +413,7 @@ _{.variable_label_prefix_dep}_ for `{{r}} params$mesos_group`.
 
 ::: {{#fig-{.chunk_name}-target}}
 
-```{{r}}
-#| fig-height: !expr saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_y={.max_chars_dep}, n_x={.n_indep}, n_cats_x={.n_cats_indep}, max_chars_x={.max_chars_indep})
+```{{r, fig.height=saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_labels_y={.max_chars_labels_dep}, max_chars_cats_y={.max_chars_cats_dep}, n_x={.n_indep}, n_cats_x={.n_cats_indep}, max_chars_labels_x={.max_chars_labels_indep}, max_chars_cats_x={.max_chars_cats_indep})}}
 library(saros)
 library(ggiraph)
 plot <- \n\tmakeme(data = data_{.chapter_foldername}, \n\t\tdep = c({.variable_name_dep}), \n\t\tindep = c({.variable_name_indep}), \n\t\ttype='cat_plot_html', \n\t\tcrowd='target', \n\t\tmesos_var = params$mesos_var, \n\t\tmesos_group = params$mesos_group)
@@ -436,8 +433,7 @@ girafe(ggobj = plot)
 
 ::: {{#fig-{.chunk_name}-others}}
 
-```{{r}}
-#| fig-height: !expr saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_y={.max_chars_dep}, n_x={.n_indep}, n_cats_x={.n_cats_indep}, max_chars_x={.max_chars_indep})
+```{{r, fig.height=saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_labels_y={.max_chars_labels_dep}, max_chars_cats_y={.max_chars_cats_dep}, n_x={.n_indep}, n_cats_x={.n_cats_indep}, max_chars_labels_x={.max_chars_labels_indep}, max_chars_cats_x={.max_chars_cats_indep})}}
 library(saros)
 library(ggiraph)
 plot <- \n\tmakeme(data = data_{.chapter_foldername}, \n\t\tdep = c({.variable_name_dep}), \n\t\tindep = c({.variable_name_indep}), \n\t\ttype='cat_plot_html', \n\t\tcrowd='others', \n\t\tmesos_var = params$mesos_var, \n\t\tmesos_group = params$mesos_group)
@@ -472,8 +468,7 @@ _{.variable_label_prefix_dep}_ by _{tolower(.variable_label_prefix_indep)}_.
 
 ::: {{#fig-{.chunk_name}-target}}
 
-```{{r}}
-#| fig-height: !expr saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_y={.max_chars_dep})
+```{{r, fig.height=saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_labels_y={.max_chars_labels_dep}, max_chars_cats_y={.max_chars_cats_dep})}}
 library(saros)
 library(ggiraph)
 plot <- \n\tmakeme(data = data_{.chapter_foldername}, \n\tdep = c({.variable_name_dep}), \n\ttype='cat_plot_html', \n\tcrowd='target', \n\tmesos_var = params$mesos_var, \n\tmesos_group = params$mesos_group)
@@ -493,8 +488,7 @@ girafe(ggobj = plot)
 
 ::: {{#fig-{.chunk_name}-others}}
 
-```{{r}}
-#| fig-height: !expr saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_y={.max_chars_dep})
+```{{r, fig.height=saros::fig_height_h_barchart(n_y={.n_dep}, n_cats_y={.n_cats_dep}, max_chars_labels_y={.max_chars_labels_dep}, max_chars_cats_y={.max_chars_cats_dep})}}
 library(saros)
 library(ggiraph)
 plot <- \n\tmakeme(data = data_{.chapter_foldername}, \n\tdep = c({.variable_name_dep}), \n\ttype='cat_plot_html', \n\tcrowd='others', \n\tmesos_var = params$mesos_var, \n\tmesos_group = params$mesos_group)

inst/WORDLIST

@@ -22,6 +22,7 @@ README
 RStudio
 Rdata
 Rds
+Rmarkdown
 Rproj
 Rstudio
 Rtools

tests/testthat/test-add_max_chars_labels_to_chapter_structure.R

@@ -0,0 +1,12 @@
+testthat::test_that("add_max_chars_labels_to_chapter_structure", {
+    testthat::expect_equal(
+        data.frame(
+            chapter = "1",
+            .variable_label_suffix_dep = c(NA, "Hello dear!")
+        ) |>
+            dplyr::group_by(chapter) |>
+            saros.base:::add_max_chars_labels_to_chapter_structure(),
+        tibble::tibble(chapter = "1", .variable_label_suffix_dep = c(NA, "Hello dear!"), .max_chars_labels_dep = c(11, 11)) |>
+            dplyr::group_by(chapter)
+    )
+})