Merged main into dev

.github/ISSUE_TEMPLATE/bug-report.md

@@ -0,0 +1,10 @@
+---
+name: Bug report
+about: Bug report
+title: 'Bug: '
+labels: 'Priority: [0] Very low, Type: Bug'
+assignees: sda030
+
+---
+
+

.github/ISSUE_TEMPLATE/feature_request.md

@@ -0,0 +1,10 @@
+---
+name: Feature request
+about: Feature request
+title: 'Feature: '
+labels: 'Type: Enhancement'
+assignees: sda030
+
+---
+
+

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: saros.contents
 Title: Contents for the Semi-Automatic Reporting of Ordinary Surveys (Saros)
-Version: 0.1.0
+Version: 0.1.1
 Authors@R: c(
     person(given = "Stephan", 
            family = "Daus", 

R/ggsaver.R

@@ -7,6 +7,7 @@
 #' @param ... Arguments forwarded to [ggplot2::ggsave()]
 #'
 #' @export
+#' @returns No return value, called for side effects
 #'
 #' @examples
 #' library(ggplot2)

R/global_settings.R

@@ -15,19 +15,21 @@ global_settings_get <- function(fn_name = "makeme") {
 #'
 #' @param fn_name String, one of `"make_link"`, `"fig_height_h_barchart"` and `"makeme"`.
 #' @param new List of arguments (see `?make_link()`, `?makeme()`, `fig_height_h_barchart()`)
-#'
+#' @param quiet Flag. If `FALSE` (default), informs about what has been set.
 #' @return Invisibly returned list of old and new values.
 #' @export
 #'
 #' @examples global_settings_set(new=list(digits=2))
-global_settings_set <- function(new, fn_name = "makeme") {
+global_settings_set <- function(new, fn_name = "makeme", quiet=FALSE) {
   saros_options <- getOption("saros", list())
   current_options <- saros_options[[paste0(fn_name, "_defaults")]]
   updated_options <- utils::modifyList(current_options, new)
   saros_options[[paste0(fn_name, "_defaults")]] <- updated_options
   options(saros = saros_options)
-  msg_part <- paste0("options('saros')$", fn_name, "_defaults")
-  cli::cli_inform("{.val {msg_part}} has now been set.")
+  if(isFALSE(quiet)) {
+    msg_part <- paste0("options('saros')$", fn_name, "_defaults")
+    cli::cli_inform("{.arg {msg_part}} has now been set.")
+  }
   invisible(list(old = current_options,
                  new = updated_options))
 }

R/make_content.R

@@ -15,6 +15,11 @@
 #'
 #'   Arguments provided by `makeme`
 #'
+#' @returns The returned object class depends on the type.
+#'   `type="*_table_html"` always returns a `tibble`.
+#'   `type="*_plot_html"` always returns a `ggplot`.
+#'   `type="*_docx"` always returns a `rdocx` object if `path=NULL`,
+#'    or has side-effect of writing docx file to disk if `path` is set.
 #'
 #' @export
 make_content <- function(type, ...) {

R/make_content.cat_plot_html.R

@@ -15,6 +15,10 @@ make_content.cat_plot_html <-
       length(indep_vars) == 0 &&
       dplyr::n_distinct(data$.variable_label) == 1
 
+    if(isTRUE(hide_axis_text)) {
+      data$.variable_label <- ""
+    }
+
     max_nchar_cat <- max(nchar(levels(data$.category)), na.rm = TRUE)
 
     percentage <- dots$data_label %in% c("percentage", "percentage_bare")
@@ -27,6 +31,7 @@ make_content.cat_plot_html <-
                                   within = data[, c(".variable_label")],
                                   fun = mean, na.rm=TRUE)
     }
+
     p <-
       dplyr::mutate(data,
                     .id = seq_len(nrow(data)),
@@ -95,8 +100,7 @@ make_content.cat_plot_html <-
         drop = FALSE) +
       scale_x_reorder(limits = rev, x_axis_label_width = dots$x_axis_label_width) +
       ggplot2::guides(
-        fill = ggiraph::guide_legend_interactive(data_id = "fill.guide",
-                                                 byrow = TRUE),
+        fill = ggiraph::guide_legend_interactive(data_id = "fill.guide"),
         colour = "none"
         )
 
@@ -105,34 +109,46 @@ make_content.cat_plot_html <-
          (dplyr::n_distinct(data$.variable_label) > 1 ||
           (dplyr::n_distinct(data$.variable_label) == 1 &&
            isFALSE(dots$hide_axis_text_if_single_variable))))) {
-      lab <- ".label"
-      p$data[[lab]] <- string_wrap(p$data[[lab]], width = dots$x_axis_label_width)
-      if(!dots$inverse) {
+
+      if(isFALSE(dots$inverse)) {
+        lab <- ".variable_label"
+        if(is.factor(p$data[[lab]])) {
+          levels(p$data[[lab]]) <- string_wrap(levels(p$data[[lab]]), width = dots$strip_width)
+        } else {
+          p$data[[lab]] <- string_wrap(p$data[[lab]], width = dots$strip_width)
+        }
 
         p <- p +
           ggiraph::facet_grid_interactive(
             rows = ggplot2::vars(.data$.variable_label),
             labeller = ggiraph::labeller_interactive(
               .mapping = ggplot2::aes(
-                data_id = .data$.variable_label,
-                tooltip = .data$.variable_label#,
-                # label = .data[[lab]]
+                data_id = .data[[lab]],
+                tooltip = .data[[lab]]
                 )
               ),
             interactive_on = "text",
             switch = "y", scales = "free", space = "free_y"
           )
-      } else {
+
+      } else if(isTRUE(dots$inverse)) {
+
+        for(lab in indep_vars) {
+          if(is.factor(p$data[[lab]])) {
+            levels(p$data[[lab]]) <- string_wrap(levels(p$data[[lab]]), width = dots$strip_width)
+          } else {
+            p$data[[lab]] <- string_wrap(p$data[[lab]], width = dots$strip_width)
+          }
+
+        }
+
         p <- p +
           ggiraph::facet_grid_interactive(
             rows = ggplot2::vars(.data[[indep_vars]]),
             labeller = ggiraph::labeller_interactive(
               .mapping = ggplot2::aes(
                 data_id = .data[[indep_vars]],
-                tooltip = .data[[indep_vars]]#,
-                # label = string_wrap(.data[[if(prop_family) indep_vars else ".label"]], # ????????????????????
-                                    # width = dots$x_axis_label_width
-                                    # )
+                tooltip = .data[[indep_vars]]
                 )
               ),
             interactive_on = "text",

R/makeme.R

@@ -322,7 +322,7 @@
 #'
 #'
 #'
-#' @return ggplot
+#' @returns ggplot-object, optionally an extended ggplot object with ggiraph features.
 #' @importFrom rlang !!!
 #' @export
 #'
@@ -555,16 +555,20 @@ makeme <-
       if(length(indep_crwd)==0) indep_crwd <- NULL
 
 
-      subset_data <- args$data[makeme_keep_rows(data = data,
-                                                crwd = crwd,
-                                                mesos_var = mesos_var,
-                                                mesos_group = mesos_group),
-                               !colnames(args$data) %in% omitted_vars_crwd, drop=FALSE]
-      # browser()
+
+      subset_data <-
+        dplyr::filter(args$data[, # subetting would remove variable labels, filter keeps them
+                               !colnames(args$data) %in% omitted_vars_crwd, drop=FALSE],
+                      makeme_keep_rows(data = data,
+                                       crwd = crwd,
+                                       mesos_var = mesos_var,
+                                       mesos_group = mesos_group))
+
       if(isTRUE(args$hide_indep_cat_for_all_crowds_if_hidden_for_crowd)) {
         for(x in indep_crwd) {
-          subset_data <- subset_data[as.character(subset_data[[x]]) %in%
-                                       kept_indep_cats_list[[crwd]][[x]], , drop = FALSE]
+          subset_data <-
+            dplyr::filter(subset_data, as.character(subset_data[[x]]) %in%
+                                       kept_indep_cats_list[[crwd]][[x]])
         }
       }