Skip to content
This repository was archived by the owner on Oct 24, 2024. It is now read-only.

Dev 0.2 #112

Merged
merged 5 commits into from
Aug 23, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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",
Expand Down
1 change: 1 addition & 0 deletions R/ggsaver.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
#' @param ... Arguments forwarded to [ggplot2::ggsave()]
#'
#' @export
#' @returns No return value, called for side effects
#'
#' @examples
#' library(ggplot2)
Expand Down
10 changes: 6 additions & 4 deletions R/global_settings.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,19 +15,21 @@
#'
#' @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.")

Check warning on line 31 in R/global_settings.R

View check run for this annotation

Codecov / codecov/patch

R/global_settings.R#L29-L31

Added lines #L29 - L31 were not covered by tests
}
invisible(list(old = current_options,
new = updated_options))
}
Expand Down
5 changes: 5 additions & 0 deletions R/make_content.R
Original file line number Diff line number Diff line change
Expand Up @@ -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, ...) {
Expand Down
39 changes: 28 additions & 11 deletions R/make_content.cat_plot_html.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,10 @@
length(indep_vars) == 0 &&
dplyr::n_distinct(data$.variable_label) == 1

if(isTRUE(hide_axis_text)) {
data$.variable_label <- ""

Check warning on line 19 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L18-L19

Added lines #L18 - L19 were not covered by tests
}

max_nchar_cat <- max(nchar(levels(data$.category)), na.rm = TRUE)

percentage <- dots$data_label %in% c("percentage", "percentage_bare")
Expand All @@ -27,6 +31,7 @@
within = data[, c(".variable_label")],
fun = mean, na.rm=TRUE)
}

p <-
dplyr::mutate(data,
.id = seq_len(nrow(data)),
Expand Down Expand Up @@ -105,34 +110,46 @@
(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)

Check warning on line 117 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L114-L117

Added lines #L114 - L117 were not covered by tests
} else {
p$data[[lab]] <- string_wrap(p$data[[lab]], width = dots$strip_width)

Check warning on line 119 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L119

Added line #L119 was not covered by tests
}

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]]

Check warning on line 128 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L127-L128

Added lines #L127 - L128 were not covered by tests
)
),
interactive_on = "text",
switch = "y", scales = "free", space = "free_y"
)
} else {

} else if(isTRUE(dots$inverse)) {

Check warning on line 135 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L135

Added line #L135 was not covered by tests

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)

Check warning on line 139 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L137-L139

Added lines #L137 - L139 were not covered by tests
} else {
p$data[[lab]] <- string_wrap(p$data[[lab]], width = dots$strip_width)

Check warning on line 141 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L141

Added line #L141 was not covered by tests
}

}

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]]

Check warning on line 152 in R/make_content.cat_plot_html.R

View check run for this annotation

Codecov / codecov/patch

R/make_content.cat_plot_html.R#L152

Added line #L152 was not covered by tests
)
),
interactive_on = "text",
Expand Down
22 changes: 13 additions & 9 deletions R/makeme.R
Original file line number Diff line number Diff line change
Expand Up @@ -322,7 +322,7 @@
#'
#'
#'
#' @return ggplot
#' @returns ggplot-object, optionally an extended ggplot object with ggiraph features.
#' @importFrom rlang !!!
#' @export
#'
Expand Down Expand Up @@ -555,16 +555,20 @@
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]])

Check warning on line 571 in R/makeme.R

View check run for this annotation

Codecov / codecov/patch

R/makeme.R#L569-L571

Added lines #L569 - L571 were not covered by tests
}
}

Expand Down
3 changes: 3 additions & 0 deletions man/ggsaver.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 3 additions & 1 deletion man/global_settings_set.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 7 additions & 0 deletions man/make_content.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/makeme.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.