diff --git a/DESCRIPTION b/DESCRIPTION index 7d85efa..9f7e132 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,7 @@ Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 Imports: + bslib, classInt, data.table, htmltools, @@ -46,7 +47,6 @@ Imports: shinybusy, writexl Suggests: - bslib, ggplot2, jsonlite, knitr, diff --git a/NAMESPACE b/NAMESPACE index d33ebf3..f15c881 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,9 @@ export(validation_ui) export(winbox_create_column) export(winbox_cut_variable) export(winbox_update_factor) +importFrom(bslib,bs_current_theme) +importFrom(bslib,bs_get_variables) +importFrom(bslib,is_bs_theme) importFrom(classInt,classIntervals) importFrom(data.table,":=") importFrom(data.table,.N) diff --git a/R/cut-variable.R b/R/cut-variable.R index f9b5ba9..70e0a43 100644 --- a/R/cut-variable.R +++ b/R/cut-variable.R @@ -130,8 +130,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { output$plot <- renderPlot({ data <- req(data_r()) variable <- req(input$variable) - # ggplot_histogram(data, variable, breaks = breaks_r()$brks) - plot_histogram(data, variable, breaks = breaks_r()$brks) + plot_histogram(data, variable, breaks = breaks_r()$brks, color = get_primary_color()) }) @@ -189,7 +188,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { column = "count", label_outside = TRUE, label_width = "40px", - bar_bg = "#112466", + bar_bg = get_primary_color(), from = c(0, max(count_data$count) + 1) ) }) @@ -262,14 +261,14 @@ winbox_cut_variable <- function(id, #' @importFrom graphics abline axis hist par plot.new plot.window -plot_histogram <- function(data, column, bins = 30, breaks = NULL) { +plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { x <- data[[column]] op <- par(mar = rep(1.5, 4)); on.exit(par(op)) plot.new() plot.window(xlim = range(pretty(x)), ylim = range(pretty(hist(x, breaks = bins, plot = FALSE)$counts))) abline(v = pretty(x), col = "#D8D8D8") abline(h = pretty(hist(x, breaks = bins, plot = FALSE)$counts), col = "#D8D8D8") - hist(x, breaks = bins, xlim = range(pretty(x)), xaxs = "i", yaxs = "i", col = "#112466", add = TRUE) + hist(x, breaks = bins, xlim = range(pretty(x)), xaxs = "i", yaxs = "i", col = color, add = TRUE) axis(side = 1, at = pretty(x), pos = 0) axis(side = 2, at = pretty(hist(x, breaks = bins, plot = FALSE)$counts), pos = min(pretty(x))) abline(v = breaks, col = "#FFFFFF", lty = 1, lwd = 1.5) diff --git a/R/update-factor.R b/R/update-factor.R index d6da17c..c449144 100644 --- a/R/update-factor.R +++ b/R/update-factor.R @@ -180,6 +180,7 @@ update_factor_server <- function(id, data_r = reactive(NULL)) { label_outside = TRUE, label_width = "30px", background = "#D8DEE9", + bar_bg = get_primary_color(), from = c(0, max(rv$data_grid$Freq) + 1) ) grid diff --git a/R/utils-shiny.R b/R/utils-shiny.R index e020566..846398f 100644 --- a/R/utils-shiny.R +++ b/R/utils-shiny.R @@ -211,3 +211,13 @@ button_close_modal <- function() { } +#' @importFrom bslib bs_current_theme is_bs_theme bs_get_variables +get_primary_color <- function() { + theme <- bslib::bs_current_theme() + if (!bslib::is_bs_theme(theme)) { + return("#112466") + } + primary <- bslib::bs_get_variables(theme, "primary") + unname(primary) +} +