fixed specific color module

dreamRs · Sep 18, 2024 · b9cd0a2 · b9cd0a2
1 parent 003a58e
commit b9cd0a2
Show file tree

Hide file tree

Showing 5 changed files with 82 additions and 36 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: esquisse
 Type: Package
 Title: Explore and Visualize Your Data Interactively
-Version: 2.0.0.9010
+Version: 2.0.0.9100
 Authors@R: c(person("Fanny", "Meyer", role = c("aut")),
   person("Victor", "Perrier", email = "[email protected]", role = c("aut", "cre")),
   person("Ian", "Carroll", comment = "Faceting support", role = "ctb"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,11 @@
+# esquisse 2.0.1
+
+* Fixed bug with Use Specific Colors when mapping a variable to color [#276](https://github.com/dreamRs/esquisse/issues/276).
+* Fixed bug with `n_geoms` different between ui and server [#272](https://github.com/dreamRs/esquisse/issues/272).
+* Update manual Chinese translation in cn.csv by [@YaoxiangLi](https://github.com/YaoxiangLi) in [#273](https://github.com/dreamRs/esquisse/pull/273).
+
+
+
 # esquisse 2.0.0
 
 * New app to use esquisse online: https://dreamrs.shinyapps.io/esquisse/.

diff --git a/R/input-colors.R b/R/input-colors.R
@@ -301,39 +301,42 @@ palette_server <- function(id, variable) {
           colors_id <- paste0("colors_", makeId(values))
           colors_manual$x <- setNames(as.list(colors_id), values)
           colors_manual$type <- "discrete"
-          lapply(
-            X = seq_along(values),
-            FUN = function(i) {
-              tagList(
-                tags$span(
-                  tagAppendAttributes(
-                    colorPickr(
-                      inputId = ns(colors_id[i]),
-                      selected = colors[i],
-                      label = NULL,
-                      theme = "classic",
-                      useAsButton = TRUE,
-                      update = "save",
-                      interaction = list(
-                        hex = FALSE,
-                        rgba = FALSE,
-                        input = TRUE,
-                        save = TRUE,
-                        clear = FALSE
+          tags$div(
+            class = "mb-3",
+            lapply(
+              X = seq_along(values),
+              FUN = function(i) {
+                tagList(
+                  tags$span(
+                    tagAppendAttributes(
+                      colorPickr(
+                        inputId = ns(colors_id[i]),
+                        selected = colors[i],
+                        label = NULL,
+                        theme = "classic",
+                        useAsButton = TRUE,
+                        update = "save",
+                        interaction = list(
+                          hex = FALSE,
+                          rgba = FALSE,
+                          input = TRUE,
+                          save = TRUE,
+                          clear = FALSE
+                        )
+                      ),
+                      style = htmltools::css(
+                        display = "inline-block",
+                        width = "auto",
+                        marginBottom = 0,
+                        verticalAlign = "middle"
                       )
                     ),
-                    style = htmltools::css(
-                      display = "inline-block",
-                      width = "auto",
-                      marginBottom = 0,
-                      verticalAlign = "middle"
-                    )
+                    values[i]
                   ),
-                  values[i]
-                ),
-                tags$br()
-              )
-            }
+                  tags$br()
+                )
+              }
+            )
           )
         } else if (identical(type, "continuous")) {
           colors <- palettes[[input$palette]]
@@ -342,7 +345,8 @@ palette_server <- function(id, variable) {
           }
           colors_manual$x <- list(low = "low", high = "high")
           colors_manual$type <- "continuous"
-          tagList(
+          tags$div(
+            class = "mb-3",
             tags$span(
               tagAppendAttributes(
                 colorPickr(

diff --git a/R/module-controls-geoms.R b/R/module-controls-geoms.R
@@ -278,13 +278,14 @@ controls_geoms_server <- function(id,
       colors_r <- palette_server("colors", reactive({
         data_ <- data_r()
         aesthetics_ <- aesthetics_r()
+        variable <- character(0)
         if ("fill" %in% names(aesthetics_)) {
-          return(data_[[aesthetics_$fill]])
+          variable <- eval_tidy(aesthetics_$fill, data = data_)
         }
-        if ("color" %in% names(aesthetics_)) {
-          return(data_[[aesthetics_$color]])
+        if ("colour" %in% names(aesthetics_)) {
+          variable <- eval_tidy(aesthetics_$colour, data = data_)
         }
-        return(character(0))
+        return(variable)
       }))
       colors_r_d <- debounce(colors_r, millis = 1000)
 

diff --git a/examples/module-palette.R b/examples/module-palette.R
@@ -0,0 +1,33 @@
+
+pkgload::load_all()
+
+library(shiny)
+
+ui <- fluidPage(
+  theme = bs_theme_esquisse(),
+  fluidRow(
+    column(
+      width = 4,
+      palette_ui("ID")
+    ),
+    column(
+      width = 8,
+      verbatimTextOutput("res")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  res <- palette_server(
+    "ID", 
+    variable = reactive(
+      palmerpenguins::penguins$species
+    )
+  )
+
+  output$res <- renderPrint(res())
+
+}
+
+shinyApp(ui, server)