diff --git a/CITATION.cff b/CITATION.cff index ae7ae538..5578f1a5 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -8,7 +8,7 @@ message: 'To cite package "FreesearchR" in publications use:' type: software license: AGPL-3.0-or-later title: 'FreesearchR: Easy data analysis for clinicians' -version: 26.3.6 +version: 26.3.5 doi: 10.5281/zenodo.14527429 identifiers: - type: url diff --git a/DESCRIPTION b/DESCRIPTION index 23174866..3a60d461 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FreesearchR Title: Easy data analysis for clinicians -Version: 26.3.6 +Version: 26.3.5 Authors@R: c( person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7559-1154")), diff --git a/NEWS.md b/NEWS.md index 04fa782b..7c2bbc32 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,3 @@ -# FreesearchR 26.3.6 - -*FIX* Plot single variable in Likert plot. - -*FIX* Horizontal stacked plot crashed. Fixed! - # FreesearchR 26.3.5 *FIX* Labelled categorical variables were not handled correctly importing from REDCap resulting in lost labels. Fixed! diff --git a/R/app_version.R b/R/app_version.R index ac06a8a2..bdf15ee5 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'26.3.6' +app_version <- function()'26.3.5' diff --git a/R/data_plots.R b/R/data_plots.R index 439b0ccf..1ae13694 100644 --- a/R/data_plots.R +++ b/R/data_plots.R @@ -117,7 +117,18 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) { #' @export data_visuals_server <- function(id, data, - palettes, + palettes = c( + "Perceptual (blue-yellow)" = "viridis", + "Perceptual (fire)" = "plasma", + "Colour-blind friendly" = "Okabe-Ito", + "Qualitative (bold)" = "Dark 2", + "Qualitative (paired)" = "Paired", + "Sequential (blues)" = "Blues", + "Diverging (red-blue)" = "RdBu", + "Tableau style" = "Tableau 10", + "Pastel" = "Pastel 1", + "Rainbow" = "rainbow" + ), ...) { shiny::moduleServer( id = id, @@ -139,6 +150,100 @@ data_visuals_server <- function(id, title = i18n$t("Download")) }) + # ## --- New attempt + # + # rv$plot.params <- shiny::reactive({ + # get_plot_options(input$type) |> purrr::pluck(1) + # }) + # + # c(output, + # list(shiny::renderUI({ + # columnSelectInput( + # inputId = ns("primary"), + # data = data, + # placeholder = "Select variable", + # label = "Response variable", + # multiple = FALSE + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$primary) + # # browser() + # + # if (!input$primary %in% names(data())) { + # plot_data <- data()[1] + # } else { + # plot_data <- data()[input$primary] + # } + # + # plots <- possible_plots( + # data = plot_data + # ) + # + # plots_named <- get_plot_options(plots) |> + # lapply(\(.x){ + # stats::setNames(.x$descr, .x$note) + # }) + # + # vectorSelectInput( + # inputId = ns("type"), + # selected = NULL, + # label = shiny::h4("Plot type"), + # choices = Reduce(c, plots_named), + # multiple = FALSE + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$type) + # + # cols <- c( + # rv$plot.params()[["secondary.extra"]], + # all_but( + # colnames(subset_types( + # data(), + # rv$plot.params()[["secondary.type"]] + # )), + # input$primary + # ) + # ) + # + # columnSelectInput( + # inputId = ns("secondary"), + # data = data, + # selected = cols[1], + # placeholder = "Please select", + # label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable", + # multiple = rv$plot.params()[["secondary.multi"]], + # maxItems = rv$plot.params()[["secondary.max"]], + # col_subset = cols, + # none_label = "No variable" + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$type) + # columnSelectInput( + # inputId = ns("tertiary"), + # data = data, + # placeholder = "Please select", + # label = "Grouping variable", + # multiple = FALSE, + # col_subset = c( + # "none", + # all_but( + # colnames(subset_types( + # data(), + # rv$plot.params()[["tertiary.type"]] + # )), + # input$primary, + # input$secondary + # ) + # ), + # none_label = "No stratification" + # ) + # }) + # )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE) + + output$primary <- shiny::renderUI({ shiny::req(data()) columnSelectInput( @@ -153,12 +258,13 @@ data_visuals_server <- function(id, # shiny::observeEvent(data, { # if (is.null(data()) | NROW(data()) == 0) { - # shiny::updateActionButton(inputId = "act_plot", disabled = TRUE) + # shiny::updateActionButton(inputId = ns("act_plot"), disabled = TRUE) # } else { - # shiny::updateActionButton(inputId = "act_plot", disabled = FALSE) + # shiny::updateActionButton(inputId = ns("act_plot"), disabled = FALSE) # } # }) + output$type <- shiny::renderUI({ shiny::req(input$primary) shiny::req(data()) @@ -504,7 +610,6 @@ supported_plots <- function() { primary.type = c("dichotomous", "categorical"), secondary.type = c("dichotomous", "categorical"), secondary.multi = TRUE, - secondary.extra = NULL, tertiary.type = c("dichotomous", "categorical"), secondary.extra = NULL ) diff --git a/R/generate_colors.R b/R/generate_colors.R index 898c0a94..ae9fa869 100644 --- a/R/generate_colors.R +++ b/R/generate_colors.R @@ -56,8 +56,7 @@ #' #' @export generate_colors <- function(n, palette = "viridis", ...) { - if (!is.numeric(n) || - length(n) != 1 || n < 1 || n != as.integer(n)) { + if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) { stop("`n` must be a single positive integer.") } @@ -70,8 +69,7 @@ generate_colors <- function(n, palette = "viridis", ...) { stop("`palette` must be a single character string or a function.") } - if (!is.numeric(n) || - length(n) != 1 || n < 1 || n != as.integer(n)) { + if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) { stop("`n` must be a single positive integer.") } if (!is.character(palette) || length(palette) != 1) { @@ -80,14 +78,10 @@ generate_colors <- function(n, palette = "viridis", ...) { palette_lower <- tolower(palette) - viridis_palettes <- c("viridis", - "magma", - "plasma", - "inferno", - "cividis", - "mako", - "rocket", - "turbo") + viridis_palettes <- c( + "viridis", "magma", "plasma", "inferno", + "cividis", "mako", "rocket", "turbo" + ) if (palette_lower %in% viridis_palettes) { viridisLite::viridis(n = n, option = palette_lower, ...) @@ -120,20 +114,16 @@ generate_colors <- function(n, palette = "viridis", ...) { grDevices::hcl.colors(n = n, palette = palette, ...) } else { - message( - paste0( - "Unknown palette: '", - palette, - "'. ", - "Falling back to default R colors.\n", - "Available options:\n", - " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", - " grDevices : hcl, rainbow, heat, terrain, topo\n", - " grDevices HCL: use grDevices::hcl.pals() to see all options\n", - " grDevices : use grDevices::palette.pals() to see all options\n", - " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" - ) - ) + message(paste0( + "Unknown palette: '", palette, "'. ", + "Falling back to default R colors.\n", + "Available options:\n", + " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", + " grDevices : hcl, rainbow, heat, terrain, topo\n", + " grDevices HCL: use grDevices::hcl.pals() to see all options\n", + " grDevices : use grDevices::palette.pals() to see all options\n", + " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" + )) viridisLite::viridis(n = n, option = "viridis") # grDevices::hcl.colors(n = n) } @@ -176,9 +166,7 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) { ramp <- grDevices::colorRamp(colors) function(x) { - if (any(x < 0 | - x > 1, na.rm = TRUE)) - stop("Values must be in [0, 1].") + if (any(x < 0 | x > 1, na.rm = TRUE)) stop("Values must be in [0, 1].") rgb_vals <- ramp(x) grDevices::rgb(rgb_vals[, 1], rgb_vals[, 2], rgb_vals[, 3], maxColorValue = 255) } @@ -212,18 +200,18 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) { #' #' @seealso [scale_color_generate()], [generate_colors()], [continuous_colors()] #' @export -scale_fill_generate <- function(palette = "viridis", - discrete = TRUE, - ...) { +scale_fill_generate <- function(palette = "viridis", discrete = TRUE, ...) { if (discrete) { ggplot2::discrete_scale( aesthetics = "fill", - palette = function(n) - generate_colors(n, palette), + palette = function(n) generate_colors(n, palette), ... ) } else { - ggplot2::scale_fill_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...) + ggplot2::scale_fill_gradientn( + colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), + ... + ) } } @@ -233,33 +221,17 @@ scale_fill_generate <- function(palette = "viridis", #' geom_point() + #' scale_color_generate(palette = "Set1") #' @export -scale_color_generate <- function(palette = "viridis", - discrete = TRUE, - ...) { +scale_color_generate <- function(palette = "viridis", discrete = TRUE, ...) { if (discrete) { ggplot2::discrete_scale( aesthetics = "colour", - palette = function(n) - generate_colors(n, palette), + palette = function(n) generate_colors(n, palette), ... ) } else { - ggplot2::scale_color_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...) + ggplot2::scale_color_gradientn( + colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), + ... + ) } } - - -color_choices <- function() { - c( - "Perceptual (blue-yellow)" = "viridis", - "Perceptual (fire)" = "plasma", - "Colour-blind friendly" = "Okabe-Ito", - "Qualitative (bold)" = "Dark 2", - "Qualitative (paired)" = "Paired", - "Sequential (blues)" = "Blues", - "Diverging (red-blue)" = "RdBu", - "Tableau style" = "Tableau 10", - "Pastel" = "Pastel 1", - "Rainbow" = "rainbow" - ) -} diff --git a/R/hosted_version.R b/R/hosted_version.R index f7e99a89..19c31921 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v26.3.6-260331' +hosted_version <- function()'v26.3.5-260330' diff --git a/R/plot_bar.R b/R/plot_bar.R index f820cc6b..909c9edd 100644 --- a/R/plot_bar.R +++ b/R/plot_bar.R @@ -56,12 +56,30 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", " if (nrow(p_data) > max_level) { + # browser() p_data <- sort_by( p_data, p_data[["Freq"]], decreasing = TRUE ) |> head(max_level) + # if (is.null(sec)){ + # p_data <- sort_by( + # p_data, + # p_data[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # } else { + # split(p_data,p_data[[sec]]) |> + # lapply(\(.x){ + # # browser() + # sort_by( + # .x, + # .x[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # }) |> dplyr::bind_rows() + # } } ## Shortens long level names diff --git a/R/plot_hbar.R b/R/plot_hbar.R index d93ef4c9..0a0ec320 100644 --- a/R/plot_hbar.R +++ b/R/plot_hbar.R @@ -10,7 +10,7 @@ #' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am") #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues") #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma") -#' mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis") +#' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis") plot_hbars <- function(data, pri, sec, @@ -41,7 +41,7 @@ vertical_stacked_bars <- function(data, score = "full_score", group = "pase_0_q", strata = NULL, - t.size = 8, + t.size = 10, l.color = "black", l.size = .5, draw.lines = TRUE, @@ -77,12 +77,12 @@ vertical_stacked_bars <- function(data, if (isTRUE(reverse)) { colors <- rev(colors) } + contrast_cut <- + contrast_text(colors, threshold = .3) == "white" score_label <- data |> get_label(var = score) group_label <- data |> get_label(var = group) - # browser() - p |> (\(.x) { .x$plot + @@ -94,7 +94,7 @@ vertical_stacked_bars <- function(data, ggplot2::aes( x = group, y = p_prev + 0.49 * p, - color = contrast_text(colors[as.numeric(score)], threshold = .3), + color = contrast_cut, # label = paste0(sprintf("%2.0f", 100 * p),"%"), # label = sprintf("%2.0f", 100 * p) label = glue::glue(label.str) @@ -103,7 +103,8 @@ vertical_stacked_bars <- function(data, ggplot2::labs(fill = score_label) + ggplot2::scale_fill_manual(values = colors) + ggplot2::theme(legend.position = "bottom", - axis.title = ggplot2::element_text(),) + + axis.title = ggplot2::element_text(), + ) + ggplot2::xlab(group_label) + ggplot2::ylab(NULL) })() diff --git a/R/plot_likert.R b/R/plot_likert.R index c18c57a1..625bb844 100644 --- a/R/plot_likert.R +++ b/R/plot_likert.R @@ -22,24 +22,18 @@ plot_likert <- function(data, ds <- list(data) } out <- lapply(ds, \(.x) { - plot_likert_single( - data = .x, - include = tidyselect::any_of(c(pri, sec)), - color.palette = color.palette - ) + .x[c(pri, sec)] |> + # na.omit() |> + plot_likert_single(color.palette = color.palette) }) wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}"))) } -plot_likert_single <- function(data, - include = dplyr::everything(), - color.palette = "viridis") { - data |> - dplyr::as_tibble() |> - ggstats::gglikert(include = include) + - scale_fill_generate(palette = color.palette) + +plot_likert_single <- function(data, color.palette = "viridis") { + ggstats::gglikert(data = data) + + scale_fill_generate(palette=color.palette)+ ggplot2::theme( # legend.position = "none", # panel.grid.major = element_blank(), diff --git a/R/sysdata.rda b/R/sysdata.rda index be267dbf..e5718750 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/SESSION.md b/SESSION.md index ae10ad0a..f232def3 100644 --- a/SESSION.md +++ b/SESSION.md @@ -4,18 +4,18 @@ |setting |value | |:-----------|:------------------------------------------| |version |R version 4.5.2 (2025-10-31) | -|os |macOS Tahoe 26.4 | +|os |macOS Tahoe 26.3 | |system |aarch64, darwin20 | |ui |RStudio | |language |(EN) | |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |Europe/Copenhagen | -|date |2026-03-31 | +|date |2026-03-30 | |rstudio |2026.01.1+403 Apple Blossom (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.7.30 @ /usr/local/bin/quarto | -|FreesearchR |26.3.6.260331 | +|FreesearchR |26.3.5.260330 | -------------------------------------------------------------------------------- @@ -84,7 +84,7 @@ |foreach |1.5.2 |2022-02-02 |CRAN (R 4.5.0) | |foreign |0.8-91 |2026-01-29 |CRAN (R 4.5.2) | |Formula |1.2-5 |2023-02-24 |CRAN (R 4.5.0) | -|FreesearchR |26.3.6 |NA |NA | +|FreesearchR |26.3.5 |NA |NA | |fs |1.6.7 |2026-03-06 |CRAN (R 4.5.2) | |gdtools |0.5.0 |2026-02-09 |CRAN (R 4.5.2) | |generics |0.1.4 |2025-05-09 |CRAN (R 4.5.0) | @@ -150,7 +150,6 @@ |pkgload |1.5.0 |2026-02-03 |CRAN (R 4.5.2) | |plyr |1.8.9 |2023-10-02 |CRAN (R 4.5.0) | |polyclip |1.10-7 |2024-07-23 |CRAN (R 4.5.0) | -|polyglotr |1.7.1 |NA |NA | |pracma |2.4.6 |2025-10-22 |CRAN (R 4.5.0) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.5.0) | |promises |1.5.0 |2025-11-01 |CRAN (R 4.5.0) | @@ -188,12 +187,10 @@ |rprojroot |2.1.1 |2025-08-26 |CRAN (R 4.5.0) | |rsconnect |1.7.0 |2025-12-06 |CRAN (R 4.5.2) | |rstudioapi |0.18.0 |2026-01-16 |CRAN (R 4.5.2) | -|rvest |1.0.5 |NA |NA | |S7 |0.2.1 |2025-11-14 |CRAN (R 4.5.2) | |sass |0.4.10 |2025-04-11 |CRAN (R 4.5.0) | |scales |1.4.0 |2025-04-24 |CRAN (R 4.5.0) | |see |0.13.0 |2026-01-30 |CRAN (R 4.5.2) | -|selectr |0.5-1 |NA |NA | |sessioninfo |1.2.3 |2025-02-05 |CRAN (R 4.5.0) | |shiny |1.13.0 |2026-02-20 |CRAN (R 4.5.2) | |shiny.i18n |0.3.0 |2023-01-16 |CRAN (R 4.5.0) | @@ -214,13 +211,10 @@ |tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.5.0) | |timechange |0.4.0 |2026-01-29 |CRAN (R 4.5.2) | |toastui |0.4.0 |2025-04-03 |CRAN (R 4.5.0) | -|triebeard |0.4.1 |NA |NA | |tweenr |2.0.3 |2024-02-26 |CRAN (R 4.5.0) | |twosamples |2.0.1 |2023-06-23 |CRAN (R 4.5.0) | |tzdb |0.5.0 |2025-03-15 |CRAN (R 4.5.0) | -|urltools |1.7.3.1 |NA |NA | |usethis |3.2.1 |2025-09-06 |CRAN (R 4.5.0) | -|utf8 |1.2.6 |2025-06-08 |CRAN (R 4.5.0) | |uuid |1.2-2 |2026-01-23 |CRAN (R 4.5.2) | |vctrs |0.7.1 |2026-01-23 |CRAN (R 4.5.2) | |viridis |0.6.5 |2024-01-29 |CRAN (R 4.5.0) | diff --git a/app_docker/app.R b/app_docker/app.R index a2b1dc19..31c047b8 100644 --- a/app_docker/app.R +++ b/app_docker/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpRQAQCo/file4ab639355bd6.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//Rtmp1OaGW3/file656737f80bdf.R ######## i18n_path <- here::here("translations") @@ -64,7 +64,7 @@ i18n$set_translation_language("en") #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'26.3.6' +app_version <- function()'26.3.5' ######## @@ -2254,7 +2254,18 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) { #' @export data_visuals_server <- function(id, data, - palettes, + palettes = c( + "Perceptual (blue-yellow)" = "viridis", + "Perceptual (fire)" = "plasma", + "Colour-blind friendly" = "Okabe-Ito", + "Qualitative (bold)" = "Dark 2", + "Qualitative (paired)" = "Paired", + "Sequential (blues)" = "Blues", + "Diverging (red-blue)" = "RdBu", + "Tableau style" = "Tableau 10", + "Pastel" = "Pastel 1", + "Rainbow" = "rainbow" + ), ...) { shiny::moduleServer( id = id, @@ -2276,6 +2287,100 @@ data_visuals_server <- function(id, title = i18n$t("Download")) }) + # ## --- New attempt + # + # rv$plot.params <- shiny::reactive({ + # get_plot_options(input$type) |> purrr::pluck(1) + # }) + # + # c(output, + # list(shiny::renderUI({ + # columnSelectInput( + # inputId = ns("primary"), + # data = data, + # placeholder = "Select variable", + # label = "Response variable", + # multiple = FALSE + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$primary) + # # browser() + # + # if (!input$primary %in% names(data())) { + # plot_data <- data()[1] + # } else { + # plot_data <- data()[input$primary] + # } + # + # plots <- possible_plots( + # data = plot_data + # ) + # + # plots_named <- get_plot_options(plots) |> + # lapply(\(.x){ + # stats::setNames(.x$descr, .x$note) + # }) + # + # vectorSelectInput( + # inputId = ns("type"), + # selected = NULL, + # label = shiny::h4("Plot type"), + # choices = Reduce(c, plots_named), + # multiple = FALSE + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$type) + # + # cols <- c( + # rv$plot.params()[["secondary.extra"]], + # all_but( + # colnames(subset_types( + # data(), + # rv$plot.params()[["secondary.type"]] + # )), + # input$primary + # ) + # ) + # + # columnSelectInput( + # inputId = ns("secondary"), + # data = data, + # selected = cols[1], + # placeholder = "Please select", + # label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable", + # multiple = rv$plot.params()[["secondary.multi"]], + # maxItems = rv$plot.params()[["secondary.max"]], + # col_subset = cols, + # none_label = "No variable" + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$type) + # columnSelectInput( + # inputId = ns("tertiary"), + # data = data, + # placeholder = "Please select", + # label = "Grouping variable", + # multiple = FALSE, + # col_subset = c( + # "none", + # all_but( + # colnames(subset_types( + # data(), + # rv$plot.params()[["tertiary.type"]] + # )), + # input$primary, + # input$secondary + # ) + # ), + # none_label = "No stratification" + # ) + # }) + # )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE) + + output$primary <- shiny::renderUI({ shiny::req(data()) columnSelectInput( @@ -2290,12 +2395,13 @@ data_visuals_server <- function(id, # shiny::observeEvent(data, { # if (is.null(data()) | NROW(data()) == 0) { - # shiny::updateActionButton(inputId = "act_plot", disabled = TRUE) + # shiny::updateActionButton(inputId = ns("act_plot"), disabled = TRUE) # } else { - # shiny::updateActionButton(inputId = "act_plot", disabled = FALSE) + # shiny::updateActionButton(inputId = ns("act_plot"), disabled = FALSE) # } # }) + output$type <- shiny::renderUI({ shiny::req(input$primary) shiny::req(data()) @@ -2641,7 +2747,6 @@ supported_plots <- function() { primary.type = c("dichotomous", "categorical"), secondary.type = c("dichotomous", "categorical"), secondary.multi = TRUE, - secondary.extra = NULL, tertiary.type = c("dichotomous", "categorical"), secondary.extra = NULL ) @@ -3813,8 +3918,7 @@ footer_ui <- function(i18n) { #' #' @export generate_colors <- function(n, palette = "viridis", ...) { - if (!is.numeric(n) || - length(n) != 1 || n < 1 || n != as.integer(n)) { + if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) { stop("`n` must be a single positive integer.") } @@ -3827,8 +3931,7 @@ generate_colors <- function(n, palette = "viridis", ...) { stop("`palette` must be a single character string or a function.") } - if (!is.numeric(n) || - length(n) != 1 || n < 1 || n != as.integer(n)) { + if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) { stop("`n` must be a single positive integer.") } if (!is.character(palette) || length(palette) != 1) { @@ -3837,14 +3940,10 @@ generate_colors <- function(n, palette = "viridis", ...) { palette_lower <- tolower(palette) - viridis_palettes <- c("viridis", - "magma", - "plasma", - "inferno", - "cividis", - "mako", - "rocket", - "turbo") + viridis_palettes <- c( + "viridis", "magma", "plasma", "inferno", + "cividis", "mako", "rocket", "turbo" + ) if (palette_lower %in% viridis_palettes) { viridisLite::viridis(n = n, option = palette_lower, ...) @@ -3877,20 +3976,16 @@ generate_colors <- function(n, palette = "viridis", ...) { grDevices::hcl.colors(n = n, palette = palette, ...) } else { - message( - paste0( - "Unknown palette: '", - palette, - "'. ", - "Falling back to default R colors.\n", - "Available options:\n", - " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", - " grDevices : hcl, rainbow, heat, terrain, topo\n", - " grDevices HCL: use grDevices::hcl.pals() to see all options\n", - " grDevices : use grDevices::palette.pals() to see all options\n", - " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" - ) - ) + message(paste0( + "Unknown palette: '", palette, "'. ", + "Falling back to default R colors.\n", + "Available options:\n", + " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", + " grDevices : hcl, rainbow, heat, terrain, topo\n", + " grDevices HCL: use grDevices::hcl.pals() to see all options\n", + " grDevices : use grDevices::palette.pals() to see all options\n", + " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" + )) viridisLite::viridis(n = n, option = "viridis") # grDevices::hcl.colors(n = n) } @@ -3933,9 +4028,7 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) { ramp <- grDevices::colorRamp(colors) function(x) { - if (any(x < 0 | - x > 1, na.rm = TRUE)) - stop("Values must be in [0, 1].") + if (any(x < 0 | x > 1, na.rm = TRUE)) stop("Values must be in [0, 1].") rgb_vals <- ramp(x) grDevices::rgb(rgb_vals[, 1], rgb_vals[, 2], rgb_vals[, 3], maxColorValue = 255) } @@ -3969,18 +4062,18 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) { #' #' @seealso [scale_color_generate()], [generate_colors()], [continuous_colors()] #' @export -scale_fill_generate <- function(palette = "viridis", - discrete = TRUE, - ...) { +scale_fill_generate <- function(palette = "viridis", discrete = TRUE, ...) { if (discrete) { ggplot2::discrete_scale( aesthetics = "fill", - palette = function(n) - generate_colors(n, palette), + palette = function(n) generate_colors(n, palette), ... ) } else { - ggplot2::scale_fill_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...) + ggplot2::scale_fill_gradientn( + colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), + ... + ) } } @@ -3990,38 +4083,22 @@ scale_fill_generate <- function(palette = "viridis", #' geom_point() + #' scale_color_generate(palette = "Set1") #' @export -scale_color_generate <- function(palette = "viridis", - discrete = TRUE, - ...) { +scale_color_generate <- function(palette = "viridis", discrete = TRUE, ...) { if (discrete) { ggplot2::discrete_scale( aesthetics = "colour", - palette = function(n) - generate_colors(n, palette), + palette = function(n) generate_colors(n, palette), ... ) } else { - ggplot2::scale_color_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...) + ggplot2::scale_color_gradientn( + colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), + ... + ) } } -color_choices <- function() { - c( - "Perceptual (blue-yellow)" = "viridis", - "Perceptual (fire)" = "plasma", - "Colour-blind friendly" = "Okabe-Ito", - "Qualitative (bold)" = "Dark 2", - "Qualitative (paired)" = "Paired", - "Sequential (blues)" = "Blues", - "Diverging (red-blue)" = "RdBu", - "Tableau style" = "Tableau 10", - "Pastel" = "Pastel 1", - "Rainbow" = "rainbow" - ) -} - - ######## #### Current file: /Users/au301842/FreesearchR/R//helpers.R ######## @@ -4925,7 +5002,7 @@ apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame() #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v26.3.6-260331' +hosted_version <- function()'v26.3.5-260330' ######## @@ -6964,12 +7041,30 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", " if (nrow(p_data) > max_level) { + # browser() p_data <- sort_by( p_data, p_data[["Freq"]], decreasing = TRUE ) |> head(max_level) + # if (is.null(sec)){ + # p_data <- sort_by( + # p_data, + # p_data[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # } else { + # split(p_data,p_data[[sec]]) |> + # lapply(\(.x){ + # # browser() + # sort_by( + # .x, + # .x[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # }) |> dplyr::bind_rows() + # } } ## Shortens long level names @@ -7293,7 +7388,7 @@ plot_euler_single <- function(data,color.palette="viridis") { #' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am") #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues") #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma") -#' mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis") +#' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis") plot_hbars <- function(data, pri, sec, @@ -7324,7 +7419,7 @@ vertical_stacked_bars <- function(data, score = "full_score", group = "pase_0_q", strata = NULL, - t.size = 8, + t.size = 10, l.color = "black", l.size = .5, draw.lines = TRUE, @@ -7360,12 +7455,12 @@ vertical_stacked_bars <- function(data, if (isTRUE(reverse)) { colors <- rev(colors) } + contrast_cut <- + contrast_text(colors, threshold = .3) == "white" score_label <- data |> get_label(var = score) group_label <- data |> get_label(var = group) - # browser() - p |> (\(.x) { .x$plot + @@ -7377,7 +7472,7 @@ vertical_stacked_bars <- function(data, ggplot2::aes( x = group, y = p_prev + 0.49 * p, - color = contrast_text(colors[as.numeric(score)], threshold = .3), + color = contrast_cut, # label = paste0(sprintf("%2.0f", 100 * p),"%"), # label = sprintf("%2.0f", 100 * p) label = glue::glue(label.str) @@ -7386,7 +7481,8 @@ vertical_stacked_bars <- function(data, ggplot2::labs(fill = score_label) + ggplot2::scale_fill_manual(values = colors) + ggplot2::theme(legend.position = "bottom", - axis.title = ggplot2::element_text(),) + + axis.title = ggplot2::element_text(), + ) + ggplot2::xlab(group_label) + ggplot2::ylab(NULL) })() @@ -7421,24 +7517,18 @@ plot_likert <- function(data, ds <- list(data) } out <- lapply(ds, \(.x) { - plot_likert_single( - data = .x, - include = tidyselect::any_of(c(pri, sec)), - color.palette = color.palette - ) + .x[c(pri, sec)] |> + # na.omit() |> + plot_likert_single(color.palette = color.palette) }) wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}"))) } -plot_likert_single <- function(data, - include = dplyr::everything(), - color.palette = "viridis") { - data |> - dplyr::as_tibble() |> - ggstats::gglikert(include = include) + - scale_fill_generate(palette = color.palette) + +plot_likert_single <- function(data, color.palette = "viridis") { + ggstats::gglikert(data = data) + + scale_fill_generate(palette=color.palette)+ ggplot2::theme( # legend.position = "none", # panel.grid.major = element_blank(), @@ -16074,9 +16164,7 @@ server <- function(input, output, session) { ######### ############################################################################## - pl <- data_visuals_server("visuals", - data = shiny::reactive(rv$list$data), - palettes = color_choices()) + pl <- data_visuals_server("visuals", data = shiny::reactive(rv$list$data)) ############################################################################## ######### diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index e64d7b30..860dcd05 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -1,7 +1,7 @@ ######## -#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpRQAQCo/file4ab61747a8d7.R +#### Current file: /var/folders/9l/xbc19wxx0g79jdd2sf_0v291mhwh7f/T//RtmpgCu9u6/file55d839c4d43b.R ######## i18n_path <- system.file("translations", package = "FreesearchR") @@ -64,7 +64,7 @@ i18n$set_translation_language("en") #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'26.3.6' +app_version <- function()'26.3.5' ######## @@ -2254,7 +2254,18 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) { #' @export data_visuals_server <- function(id, data, - palettes, + palettes = c( + "Perceptual (blue-yellow)" = "viridis", + "Perceptual (fire)" = "plasma", + "Colour-blind friendly" = "Okabe-Ito", + "Qualitative (bold)" = "Dark 2", + "Qualitative (paired)" = "Paired", + "Sequential (blues)" = "Blues", + "Diverging (red-blue)" = "RdBu", + "Tableau style" = "Tableau 10", + "Pastel" = "Pastel 1", + "Rainbow" = "rainbow" + ), ...) { shiny::moduleServer( id = id, @@ -2276,6 +2287,100 @@ data_visuals_server <- function(id, title = i18n$t("Download")) }) + # ## --- New attempt + # + # rv$plot.params <- shiny::reactive({ + # get_plot_options(input$type) |> purrr::pluck(1) + # }) + # + # c(output, + # list(shiny::renderUI({ + # columnSelectInput( + # inputId = ns("primary"), + # data = data, + # placeholder = "Select variable", + # label = "Response variable", + # multiple = FALSE + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$primary) + # # browser() + # + # if (!input$primary %in% names(data())) { + # plot_data <- data()[1] + # } else { + # plot_data <- data()[input$primary] + # } + # + # plots <- possible_plots( + # data = plot_data + # ) + # + # plots_named <- get_plot_options(plots) |> + # lapply(\(.x){ + # stats::setNames(.x$descr, .x$note) + # }) + # + # vectorSelectInput( + # inputId = ns("type"), + # selected = NULL, + # label = shiny::h4("Plot type"), + # choices = Reduce(c, plots_named), + # multiple = FALSE + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$type) + # + # cols <- c( + # rv$plot.params()[["secondary.extra"]], + # all_but( + # colnames(subset_types( + # data(), + # rv$plot.params()[["secondary.type"]] + # )), + # input$primary + # ) + # ) + # + # columnSelectInput( + # inputId = ns("secondary"), + # data = data, + # selected = cols[1], + # placeholder = "Please select", + # label = if (isTRUE(rv$plot.params()[["secondary.multi"]])) "Additional variables" else "Secondary variable", + # multiple = rv$plot.params()[["secondary.multi"]], + # maxItems = rv$plot.params()[["secondary.max"]], + # col_subset = cols, + # none_label = "No variable" + # ) + # }), + # shiny::renderUI({ + # shiny::req(input$type) + # columnSelectInput( + # inputId = ns("tertiary"), + # data = data, + # placeholder = "Please select", + # label = "Grouping variable", + # multiple = FALSE, + # col_subset = c( + # "none", + # all_but( + # colnames(subset_types( + # data(), + # rv$plot.params()[["tertiary.type"]] + # )), + # input$primary, + # input$secondary + # ) + # ), + # none_label = "No stratification" + # ) + # }) + # )|> setNames(c("primary","type","secondary","tertiary")),keep.null = TRUE) + + output$primary <- shiny::renderUI({ shiny::req(data()) columnSelectInput( @@ -2290,12 +2395,13 @@ data_visuals_server <- function(id, # shiny::observeEvent(data, { # if (is.null(data()) | NROW(data()) == 0) { - # shiny::updateActionButton(inputId = "act_plot", disabled = TRUE) + # shiny::updateActionButton(inputId = ns("act_plot"), disabled = TRUE) # } else { - # shiny::updateActionButton(inputId = "act_plot", disabled = FALSE) + # shiny::updateActionButton(inputId = ns("act_plot"), disabled = FALSE) # } # }) + output$type <- shiny::renderUI({ shiny::req(input$primary) shiny::req(data()) @@ -2641,7 +2747,6 @@ supported_plots <- function() { primary.type = c("dichotomous", "categorical"), secondary.type = c("dichotomous", "categorical"), secondary.multi = TRUE, - secondary.extra = NULL, tertiary.type = c("dichotomous", "categorical"), secondary.extra = NULL ) @@ -3813,8 +3918,7 @@ footer_ui <- function(i18n) { #' #' @export generate_colors <- function(n, palette = "viridis", ...) { - if (!is.numeric(n) || - length(n) != 1 || n < 1 || n != as.integer(n)) { + if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) { stop("`n` must be a single positive integer.") } @@ -3827,8 +3931,7 @@ generate_colors <- function(n, palette = "viridis", ...) { stop("`palette` must be a single character string or a function.") } - if (!is.numeric(n) || - length(n) != 1 || n < 1 || n != as.integer(n)) { + if (!is.numeric(n) || length(n) != 1 || n < 1 || n != as.integer(n)) { stop("`n` must be a single positive integer.") } if (!is.character(palette) || length(palette) != 1) { @@ -3837,14 +3940,10 @@ generate_colors <- function(n, palette = "viridis", ...) { palette_lower <- tolower(palette) - viridis_palettes <- c("viridis", - "magma", - "plasma", - "inferno", - "cividis", - "mako", - "rocket", - "turbo") + viridis_palettes <- c( + "viridis", "magma", "plasma", "inferno", + "cividis", "mako", "rocket", "turbo" + ) if (palette_lower %in% viridis_palettes) { viridisLite::viridis(n = n, option = palette_lower, ...) @@ -3877,20 +3976,16 @@ generate_colors <- function(n, palette = "viridis", ...) { grDevices::hcl.colors(n = n, palette = palette, ...) } else { - message( - paste0( - "Unknown palette: '", - palette, - "'. ", - "Falling back to default R colors.\n", - "Available options:\n", - " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", - " grDevices : hcl, rainbow, heat, terrain, topo\n", - " grDevices HCL: use grDevices::hcl.pals() to see all options\n", - " grDevices : use grDevices::palette.pals() to see all options\n", - " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" - ) - ) + message(paste0( + "Unknown palette: '", palette, "'. ", + "Falling back to default R colors.\n", + "Available options:\n", + " viridisLite : viridis, magma, plasma, inferno, cividis, mako, rocket, turbo\n", + " grDevices : hcl, rainbow, heat, terrain, topo\n", + " grDevices HCL: use grDevices::hcl.pals() to see all options\n", + " grDevices : use grDevices::palette.pals() to see all options\n", + " RColorBrewer : use RColorBrewer::brewer.pal.info to see all options" + )) viridisLite::viridis(n = n, option = "viridis") # grDevices::hcl.colors(n = n) } @@ -3933,9 +4028,7 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) { ramp <- grDevices::colorRamp(colors) function(x) { - if (any(x < 0 | - x > 1, na.rm = TRUE)) - stop("Values must be in [0, 1].") + if (any(x < 0 | x > 1, na.rm = TRUE)) stop("Values must be in [0, 1].") rgb_vals <- ramp(x) grDevices::rgb(rgb_vals[, 1], rgb_vals[, 2], rgb_vals[, 3], maxColorValue = 255) } @@ -3969,18 +4062,18 @@ continuous_colors <- function(palette = "viridis", n = 256, ...) { #' #' @seealso [scale_color_generate()], [generate_colors()], [continuous_colors()] #' @export -scale_fill_generate <- function(palette = "viridis", - discrete = TRUE, - ...) { +scale_fill_generate <- function(palette = "viridis", discrete = TRUE, ...) { if (discrete) { ggplot2::discrete_scale( aesthetics = "fill", - palette = function(n) - generate_colors(n, palette), + palette = function(n) generate_colors(n, palette), ... ) } else { - ggplot2::scale_fill_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...) + ggplot2::scale_fill_gradientn( + colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), + ... + ) } } @@ -3990,38 +4083,22 @@ scale_fill_generate <- function(palette = "viridis", #' geom_point() + #' scale_color_generate(palette = "Set1") #' @export -scale_color_generate <- function(palette = "viridis", - discrete = TRUE, - ...) { +scale_color_generate <- function(palette = "viridis", discrete = TRUE, ...) { if (discrete) { ggplot2::discrete_scale( aesthetics = "colour", - palette = function(n) - generate_colors(n, palette), + palette = function(n) generate_colors(n, palette), ... ) } else { - ggplot2::scale_color_gradientn(colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), ...) + ggplot2::scale_color_gradientn( + colors = continuous_colors(palette)(seq(0, 1, length.out = 256)), + ... + ) } } -color_choices <- function() { - c( - "Perceptual (blue-yellow)" = "viridis", - "Perceptual (fire)" = "plasma", - "Colour-blind friendly" = "Okabe-Ito", - "Qualitative (bold)" = "Dark 2", - "Qualitative (paired)" = "Paired", - "Sequential (blues)" = "Blues", - "Diverging (red-blue)" = "RdBu", - "Tableau style" = "Tableau 10", - "Pastel" = "Pastel 1", - "Rainbow" = "rainbow" - ) -} - - ######## #### Current file: /Users/au301842/FreesearchR/R//helpers.R ######## @@ -4925,7 +5002,7 @@ apply_idea_filter <- function(filtered_reactive, df_target, env = parent.frame() #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v26.3.6-260331' +hosted_version <- function()'v26.3.5-260330' ######## @@ -6964,12 +7041,30 @@ plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", " if (nrow(p_data) > max_level) { + # browser() p_data <- sort_by( p_data, p_data[["Freq"]], decreasing = TRUE ) |> head(max_level) + # if (is.null(sec)){ + # p_data <- sort_by( + # p_data, + # p_data[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # } else { + # split(p_data,p_data[[sec]]) |> + # lapply(\(.x){ + # # browser() + # sort_by( + # .x, + # .x[["Freq"]], + # decreasing=TRUE) |> + # head(max_level) + # }) |> dplyr::bind_rows() + # } } ## Shortens long level names @@ -7293,7 +7388,7 @@ plot_euler_single <- function(data,color.palette="viridis") { #' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am") #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues") #' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma") -#' mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis") +#' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis") plot_hbars <- function(data, pri, sec, @@ -7324,7 +7419,7 @@ vertical_stacked_bars <- function(data, score = "full_score", group = "pase_0_q", strata = NULL, - t.size = 8, + t.size = 10, l.color = "black", l.size = .5, draw.lines = TRUE, @@ -7360,12 +7455,12 @@ vertical_stacked_bars <- function(data, if (isTRUE(reverse)) { colors <- rev(colors) } + contrast_cut <- + contrast_text(colors, threshold = .3) == "white" score_label <- data |> get_label(var = score) group_label <- data |> get_label(var = group) - # browser() - p |> (\(.x) { .x$plot + @@ -7377,7 +7472,7 @@ vertical_stacked_bars <- function(data, ggplot2::aes( x = group, y = p_prev + 0.49 * p, - color = contrast_text(colors[as.numeric(score)], threshold = .3), + color = contrast_cut, # label = paste0(sprintf("%2.0f", 100 * p),"%"), # label = sprintf("%2.0f", 100 * p) label = glue::glue(label.str) @@ -7386,7 +7481,8 @@ vertical_stacked_bars <- function(data, ggplot2::labs(fill = score_label) + ggplot2::scale_fill_manual(values = colors) + ggplot2::theme(legend.position = "bottom", - axis.title = ggplot2::element_text(),) + + axis.title = ggplot2::element_text(), + ) + ggplot2::xlab(group_label) + ggplot2::ylab(NULL) })() @@ -7421,24 +7517,18 @@ plot_likert <- function(data, ds <- list(data) } out <- lapply(ds, \(.x) { - plot_likert_single( - data = .x, - include = tidyselect::any_of(c(pri, sec)), - color.palette = color.palette - ) + .x[c(pri, sec)] |> + # na.omit() |> + plot_likert_single(color.palette = color.palette) }) wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}"))) } -plot_likert_single <- function(data, - include = dplyr::everything(), - color.palette = "viridis") { - data |> - dplyr::as_tibble() |> - ggstats::gglikert(include = include) + - scale_fill_generate(palette = color.palette) + +plot_likert_single <- function(data, color.palette = "viridis") { + ggstats::gglikert(data = data) + + scale_fill_generate(palette=color.palette)+ ggplot2::theme( # legend.position = "none", # panel.grid.major = element_blank(), @@ -16074,9 +16164,7 @@ server <- function(input, output, session) { ######### ############################################################################## - pl <- data_visuals_server("visuals", - data = shiny::reactive(rv$list$data), - palettes = color_choices()) + pl <- data_visuals_server("visuals", data = shiny::reactive(rv$list$data)) ############################################################################## ######### diff --git a/man/data-plots.Rd b/man/data-plots.Rd index 6da5a230..8f6534f4 100644 --- a/man/data-plots.Rd +++ b/man/data-plots.Rd @@ -21,7 +21,16 @@ \usage{ data_visuals_ui(id, tab_title = "Plots", ...) -data_visuals_server(id, data, palettes, ...) +data_visuals_server( + id, + data, + palettes = c(`Perceptual (blue-yellow)` = "viridis", `Perceptual (fire)` = "plasma", + `Colour-blind friendly` = "Okabe-Ito", `Qualitative (bold)` = "Dark 2", + `Qualitative (paired)` = "Paired", `Sequential (blues)` = "Blues", + `Diverging (red-blue)` = "RdBu", `Tableau style` = "Tableau 10", Pastel = "Pastel 1", + Rainbow = "rainbow"), + ... +) create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...) @@ -161,7 +170,7 @@ mtcars |> plot_hbars(pri = "carb", sec = "cyl") mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am") mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues") mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma") -mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis") +mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Viridis") mtcars |> plot_likert(pri = "carb", sec = "cyl") mtcars |> plot_likert(pri = "carb", sec = "cyl", ter="am") mtcars |> plot_likert(pri = "cyl",color.palette="Blues") diff --git a/man/vertical_stacked_bars.Rd b/man/vertical_stacked_bars.Rd index 75335365..495588fe 100644 --- a/man/vertical_stacked_bars.Rd +++ b/man/vertical_stacked_bars.Rd @@ -9,7 +9,7 @@ vertical_stacked_bars( score = "full_score", group = "pase_0_q", strata = NULL, - t.size = 8, + t.size = 10, l.color = "black", l.size = 0.5, draw.lines = TRUE,