added cut variable module

NAMESPACE

@@ -44,6 +44,8 @@ importFrom(bslib,nav_select)
 importFrom(bslib,navset_hidden)
 importFrom(bslib,navset_pill)
 importFrom(bslib,sidebar)
+importFrom(datamods,cut_variable_server)
+importFrom(datamods,cut_variable_ui)
 importFrom(datamods,filter_data_server)
 importFrom(datamods,filter_data_ui)
 importFrom(datamods,i18n)

R/esquisse-server.R

@@ -107,13 +107,19 @@ esquisse_server <- function(id,
       observeEvent(updated_data(), {
         data_chart$data <- updated_data()
       })
-      
+
       # create column modal
       created_col <- create_col_server("create_col", reactive(data_chart$data))
       observeEvent(created_col(), {
         data_chart$data <- created_col()
       })
 
+      # cut variable modal
+      cutted_var <- cut_var_server("cut_var", reactive(data_chart$data))
+      observeEvent(cutted_var(), {
+        data_chart$data <- cutted_var()
+      })
+
 
 
       ### Geom & aesthetics selection

R/esquisse-ui.R

@@ -74,7 +74,8 @@ esquisse_ui <- function(id,
       header_btns$import_data(ns("launch_import_data")),
       header_btns$show_data(ns("show_data")),
       header_btns$update_variable(ns("update_variable")),
-      header_btns$create_column(ns("create_col"))
+      header_btns$create_column(ns("create_col")),
+      header_btns$cut_variable(ns("cut_var"))
     )
   )
 
@@ -233,6 +234,7 @@ esquisse_container <- function(width = "100%", height = "700px", fixed = FALSE)
 #' @param show_data Show button to display data.
 #' @param update_variable Show button to update selected variables and convert them.
 #' @param create_column Show button to create a new column based on an expression.
+#' @param cut_variable Show button to allow to convert a numeric variable into factors.
 #' @param settings Show button to open settings modal (to select aesthetics to use).
 #' @param close Show button to stop the app and close addin.
 #'
@@ -244,13 +246,15 @@ esquisse_header <- function(import_data = TRUE,
                             show_data = TRUE,
                             update_variable = TRUE,
                             create_column = TRUE,
+                            cut_variable = TRUE,
                             settings = TRUE,
                             close = TRUE) {
   list(
     import_data = isTRUE(import_data),
     show_data = isTRUE(show_data),
     update_variable = isTRUE(update_variable),
     create_column = isTRUE(create_column),
+    cut_variable = isTRUE(cut_variable),
     settings = isTRUE(settings),
     close = isTRUE(close)
   )
@@ -279,6 +283,11 @@ make_btn_header <- function(.list) {
     } else {
       function(id) NULL
     },
+    cut_variable = if (isTRUE(.list$cut_variable)) {
+      cut_var_ui
+    } else {
+      function(id) NULL
+    },
     settings = if (isTRUE(.list$settings)) {
       btn_header(i18n("Display settings"), "gear-fine")
     } else {
@@ -292,13 +301,14 @@ make_btn_header <- function(.list) {
   )
 }
 
-btn_header <- function(label, icon) {
+btn_header <- function(label, icon, class = NULL) {
   function(id) {
     actionButton(
       inputId = id,
-      label = ph(icon, height = "2em", title = label),
+      label = if (is.character(icon)) ph(icon, height = "2em", title = label) else icon,
       class = "btn-sm btn-primary",
-      title = label
+      title = label,
+      class = class
     )
   }
 }

R/module-utils.R

@@ -2,9 +2,22 @@
 # Show data -------------------------------------------------------------------------
 
 #' @importFrom shiny NS
+#' @importFrom htmltools tags css
+#' @importFrom phosphoricons ph
 show_data_ui <- function(id) {
   ns <- NS(id)
-  btn_header(i18n("Show data"), "table")(ns("btn"))
+  icon <- tags$div(
+    style = css(position = "relative", width = "35px"),
+    ph("table", height = "2em", title = i18n("Show data")),
+    ph(
+      "eye",
+      style = css(position = "absolute", top = 0, right = 0),
+      height = "1.2em",
+      weight = "bold",
+      title = i18n("Show data")
+    )
+  )
+  btn_header(i18n("Show data"), icon, class = " px-0")(ns("btn"))
 }
 
 #' @importFrom shiny moduleServer observeEvent showNotification reactive
@@ -13,7 +26,7 @@ show_data_server <- function(id, data_r = reactive(NULL)) {
   moduleServer(
     id,
     function(input, output, session) {
-      
+
       observeEvent(input$btn, {
         data <- data_r()
         if (!is.data.frame(data)) {
@@ -27,7 +40,7 @@ show_data_server <- function(id, data_r = reactive(NULL)) {
           show_data(data, title = i18n("Dataset"), type = "modal")
         }
       })
-      
+
     }
   )
 }
@@ -38,9 +51,22 @@ show_data_server <- function(id, data_r = reactive(NULL)) {
 # Update vars -----------------------------------------------------------------------
 
 #' @importFrom shiny NS
+#' @importFrom htmltools tags css
+#' @importFrom phosphoricons ph
 update_vars_ui <- function(id) {
   ns <- NS(id)
-  btn_header(i18n("Update variables"), "brackets-angle")(ns("btn"))
+  icon <- tags$div(
+    style = css(position = "relative", width = "35px"),
+    ph("table", height = "2em", title = i18n("Update variables")),
+    ph(
+      "gear",
+      style = css(position = "absolute", top = 0, right = 0),
+      height = "1.2em",
+      weight = "bold",
+      title = i18n("Update variables")
+    )
+  )
+  btn_header(i18n("Update variables"), icon, class = " px-0")(ns("btn"))
 }
 
 #' @importFrom shiny moduleServer observeEvent modalDialog showModal reactive
@@ -91,7 +117,7 @@ create_col_server <- function(id, data_r = reactive(NULL)) {
     function(input, output, session) {
       ns <- session$ns
       observeEvent(input$btn, datamods::modal_create_column(ns("mod")))
-      res <-datamods::create_column_server(
+      res <- datamods::create_column_server(
         id = "mod",
         data = data_r
       )
@@ -101,3 +127,44 @@ create_col_server <- function(id, data_r = reactive(NULL)) {
 }
 
 
+
+
+
+# Cut variable ------------------------------------------------------------
+
+#' @importFrom shiny NS
+#' @importFrom htmltools tags css
+#' @importFrom phosphoricons ph
+cut_var_ui <- function(id) {
+  ns <- NS(id)
+  icon <- tags$div(
+    style = css(position = "relative", width = "35px"),
+    ph("list-numbers", height = "2em", title = i18n("Cut numeric variable into factors")),
+    ph(
+      "scissors",
+      style = css(position = "absolute", top = 0, right = 0, transform = "scale(-1, 1)"),
+      height = "1.2em",
+      weight = "bold",
+      title = i18n("Cut numeric variable into factors")
+    )
+  )
+  btn_header(i18n("Cut numeric variable into factors"), class = " px-0", icon)(ns("btn"))
+}
+
+#' @importFrom shiny moduleServer observeEvent modalDialog showModal reactive
+#' @importFrom datamods cut_variable_ui cut_variable_server
+cut_var_server <- function(id, data_r = reactive(NULL)) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+      ns <- session$ns
+      observeEvent(input$btn, datamods::modal_cut_variable(ns("mod")))
+      observeEvent(res(), shiny::removeModal())
+      res <- datamods::cut_variable_server(
+        id = "mod",
+        data = data_r
+      )
+      return(res)
+    }
+  )
+}