Merge branch 'master' of https://github.com/dreamRs/datamods

DESCRIPTION

@@ -47,6 +47,7 @@ Imports:
     writexl
 Suggests: 
     bslib,
+    ggplot2,
     jsonlite,
     knitr,
     MASS,

NAMESPACE

@@ -28,12 +28,15 @@ export(list_allowed_operations)
 export(list_pkg_data)
 export(modal_create_column)
 export(modal_cut_variable)
+export(modal_update_factor)
 export(sample_server)
 export(sample_ui)
 export(select_group_server)
 export(select_group_ui)
 export(set_i18n)
 export(show_data)
+export(update_factor_server)
+export(update_factor_ui)
 export(update_variables_server)
 export(update_variables_ui)
 export(validation_server)
@@ -133,7 +136,6 @@ importFrom(shiny,reactiveValuesToList)
 importFrom(shiny,removeModal)
 importFrom(shiny,removeUI)
 importFrom(shiny,renderPlot)
-importFrom(shiny,renderTable)
 importFrom(shiny,renderUI)
 importFrom(shiny,req)
 importFrom(shiny,selectizeInput)
@@ -142,8 +144,8 @@ importFrom(shiny,singleton)
 importFrom(shiny,sliderInput)
 importFrom(shiny,tabPanel)
 importFrom(shiny,tabPanelBody)
-importFrom(shiny,tableOutput)
 importFrom(shiny,tabsetPanel)
+importFrom(shiny,tagList)
 importFrom(shiny,tags)
 importFrom(shiny,textAreaInput)
 importFrom(shiny,textInput)
@@ -179,6 +181,7 @@ importFrom(shinybusy,notify_warning)
 importFrom(stats,setNames)
 importFrom(tibble,as_tibble)
 importFrom(toastui,datagrid)
+importFrom(toastui,datagridOutput)
 importFrom(toastui,datagridOutput2)
 importFrom(toastui,grid_colorbar)
 importFrom(toastui,grid_columns)
@@ -187,6 +190,7 @@ importFrom(toastui,grid_editor_opts)
 importFrom(toastui,grid_format)
 importFrom(toastui,grid_selection_row)
 importFrom(toastui,grid_style_column)
+importFrom(toastui,renderDatagrid)
 importFrom(toastui,renderDatagrid2)
 importFrom(tools,file_ext)
 importFrom(utils,data)

NEWS.md

@@ -1,4 +1,9 @@
-# datamods 1.4.6
+# datamods 1.5.1
+
+* New module `update_factor_ui()` / `update_factor_server()` to reorder levels of a factor.
+
+
+# datamods 1.5.0
 
 * New module `create_column_ui()` / `create_column_server()` to add new column based on an expression to a `data.frame`.
 * New module `cut_variable_ui()` / `cut_variable_server()` to cut a numeric factor into several interval.

R/create-column.R

@@ -2,7 +2,7 @@
 #' @title Create new column
 #'
 #' @description
-#' This module allow to enter an expression to create a new column in `data.frame`.
+#' This module allow to enter an expression to create a new column in a `data.frame`.
 #'
 #'
 #' @param id Module's ID.
@@ -34,7 +34,7 @@ create_column_ui <- function(id) {
         width = 6,
         textInput(
           inputId = ns("new_column"),
-          label = "New column name:",
+          label = i18n("New column name:"),
           value = "new_column1",
           width = "100%"
         )
@@ -43,7 +43,7 @@ create_column_ui <- function(id) {
         width = 6,
         virtualSelectInput(
           inputId = ns("group_by"),
-          label = "Group calculation by:",
+          label = i18n("Group calculation by:"),
           choices = NULL,
           multiple = TRUE,
           disableSelectAll = TRUE,
@@ -54,15 +54,15 @@ create_column_ui <- function(id) {
     ),
     textAreaInput(
       inputId = ns("expression"),
-      label = "Enter an expression to define new column:",
+      label = i18n("Enter an expression to define new column:"),
       value = "",
       width = "100%",
       rows = 6
     ),
     tags$i(
       class = "d-block",
       ph("info"),
-      "Click on a column to add it to the expression:"
+      i18n("Click on a column name to add it to the expression:")
     ),
     uiOutput(outputId = ns("columns")),
     uiOutput(outputId = ns("feedback")),
@@ -76,7 +76,7 @@ create_column_ui <- function(id) {
       actionButton(
         inputId = ns("compute"),
         label = tagList(
-          ph("gear"), "Create column"
+          ph("gear"), i18n("Create column")
         ),
         class = "btn-outline-primary",
         width = "100%"
@@ -115,9 +115,9 @@ create_column_server <- function(id,
       info_alert <- alert(
         status = "info",
         ph("question"),
-        "Choose a name for the column to be created or modified,",
-        "then enter an expression before clicking on the button above to validate or on ",
-        ph("trash"), "to delete it."
+        i18n("Choose a name for the column to be created or modified,"),
+        i18n("then enter an expression before clicking on the button above to validate or on "),
+        ph("trash"), i18n("to delete it.")
       )
 
       rv <- reactiveValues(
@@ -163,7 +163,7 @@ create_column_server <- function(id,
         if (input$new_column == "") {
           rv$feedback <- alert(
             status = "warning",
-            ph("warning"), "New column name cannot be empty"
+            ph("warning"), i18n("New column name cannot be empty")
           )
         }
       })
@@ -287,7 +287,7 @@ try_compute_column <- function(expression,
   }
   funs <- unlist(c(extract_calls(parsed), lapply(parsed, extract_calls)), recursive = TRUE)
   if (!are_allowed_operations(funs, allowed_operations)) {
-    return(alert_error("Some operations are not allowed"))
+    return(alert_error(i18n("Some operations are not allowed")))
   }
   if (!isTruthy(by)) {
     result <- try(
@@ -315,15 +315,19 @@ try_compute_column <- function(expression,
   code <- if (!isTruthy(by)) {
     call2("mutate", !!!set_names(list(parse_expr(expression)), name))
   } else {
-    expr(
-      !!expr(group_by(!!!syms(by))) %>%
-        !!call2("mutate", !!!set_names(list(parse_expr(expression)), name))
+    call2(
+      "mutate",
+      !!!set_names(list(parse_expr(expression)), name),
+      !!!list(.by = expr(c(!!!syms(by))))
     )
   }
-  attr(rv$data, "code") <- c(attr(rv$data, "code"),  code)
+  attr(rv$data, "code") <- Reduce(
+    f = function(x, y) expr(!!x %>% !!y),
+    x = c(attr(rv$data, "code"),  code)
+  )
   alert(
     status = "success",
-    ph("check"), "Column added!"
+    ph("check"), i18n("Column added!")
   )
 }
 
@@ -403,7 +407,7 @@ make_choices_with_infos <- function(data) {
           icon, nm
         )),
         value = nm,
-        description = paste("Unique values:", data.table::uniqueN(values))
+        description = paste(i18n("Unique values:"), data.table::uniqueN(values))
       )
     }
   )

R/cut-variable.R

@@ -2,7 +2,7 @@
 #' @title Module to Convert Numeric to Factor
 #'
 #' @description
-#' This module contain an interface to cut a numeric factor into several intervals.
+#' This module contain an interface to cut a numeric into several intervals.
 #'
 #'
 #' @param id Module ID.
@@ -25,7 +25,7 @@ cut_variable_ui <- function(id) {
         width = 3,
         virtualSelectInput(
           inputId = ns("variable"),
-          label = "Variable to cut:",
+          label = i18n("Variable to cut:"),
           choices = NULL,
           width = "100%"
         )
@@ -34,7 +34,7 @@ cut_variable_ui <- function(id) {
         width = 3,
         virtualSelectInput(
           inputId = ns("method"),
-          label = "Method:",
+          label = i18n("Method:"),
           choices = c(
             "sd",
             "equal",
@@ -57,7 +57,7 @@ cut_variable_ui <- function(id) {
         width = 3,
         numericInput(
           inputId = ns("n_breaks"),
-          label = "Number of breaks:",
+          label = i18n("Number of breaks:"),
           value = 5,
           min = 2,
           max = 12,
@@ -68,12 +68,12 @@ cut_variable_ui <- function(id) {
         width = 3,
         checkboxInput(
           inputId = ns("right"),
-          label = "Close intervals on the right",
+          label = i18n("Close intervals on the right"),
           value = TRUE
         ),
         checkboxInput(
           inputId = ns("include_lowest"),
-          label = "Include lowest value",
+          label = i18n("Include lowest value"),
           value = FALSE
         )
       )
@@ -82,7 +82,7 @@ cut_variable_ui <- function(id) {
     datagridOutput2(outputId = ns("count")),
     actionButton(
       inputId = ns("create"),
-      label = tagList(ph("scissors"), "Create factor variable"),
+      label = tagList(ph("scissors"), i18n("Create factor variable")),
       class = "btn-outline-primary float-end"
     ),
     tags$div(class = "clearfix")
@@ -96,7 +96,7 @@ cut_variable_ui <- function(id) {
 #' @importFrom shiny moduleServer observeEvent reactive req bindEvent renderPlot
 #' @importFrom shinyWidgets updateVirtualSelect
 #' @importFrom toastui renderDatagrid2 datagrid grid_colorbar
-#' @importFrom rlang %||%
+#' @importFrom rlang %||% call2 set_names expr syms
 #' @importFrom classInt classIntervals
 #'
 #' @rdname cut-variable
@@ -144,6 +144,22 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) {
           include.lowest = input$include_lowest,
           right = input$right
         )
+        code <- call2(
+          "mutate",
+          !!!set_names(
+            list(
+              expr(cut(
+                !!!syms(list(x = variable)),
+                !!!list(breaks = breaks_r()$brks, include.lowest = input$include_lowest, right = input$right)
+              ))
+            ),
+            paste0(variable, "_cut")
+          )
+        )
+        attr(data, "code") <- Reduce(
+          f = function(x, y) expr(!!x %>% !!y),
+          x = c(attr(data, "code"),  code)
+        )
         data
       })