News 2025.02.02-1

lgschuck · Feb 3, 2025 · 2eb1206 · 2eb1206
1 parent a24c03b
commit 2eb1206
Show file tree

Hide file tree

Showing 9 changed files with 165 additions and 58 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -22,6 +22,21 @@ editor_options:
 
 7 - Models: linear model, logistic regression, Kmeans, Trees
 
+## 2025.02.02-1
+
+Highlights: new module Rename Cols and bug fix
+
+### Bug Fixes
+
+1 - **Analysis > Descriptive Stats: error in round for factors**: now f_num function only format numeric values
+([#16](https://github.com/lgschuck/spada/issues/16))
+
+### Improvements
+
+1 - **navbar_df_info and sidebar** modules: now number of rows with 1 decimal value (function f_num) for better look (solve side effect after use of nsmall in previous release)
+
+2 - New **Rename Cols** module: new module for rename variables of active dataset
+
 ## 2025.02.01-1
 
 Only visual and formatting changes.

diff --git a/R/f_num.R b/R/f_num.R
@@ -25,17 +25,21 @@
 f_num <- function(x, big = ',', dec = '.', thousand = 'K',
                   million = 'M', billion = 'B', dig = 0){
 
-  fcase(
-    is.infinite(x), paste(x),
-    x > 1e9,
-    paste(format(round(x/1e9, digits = dig), nsmall = dig,
-                 decimal.mark = dec, big.mark = big, scientific = F), billion),
-    x > 1e6,
-    paste(format(round(x/1e6, digits = dig), nsmall = dig,
-                 decimal.mark = dec, big.mark = big, scientific = F), million),
-    x > 1e3,
-    paste(format(round(x/1e3, digits = dig), nsmall = dig,
-                 decimal.mark = dec, big.mark = big, scientific = F), thousand),
-    default = format(round(x, dig), nsmall = dig, scientific = F)
+  if(x |> is.numeric()){
+    fcase(
+      is.infinite(x), paste(x),
+      x > 1e9,
+      paste(format(round(x/1e9, digits = dig), nsmall = dig,
+                   decimal.mark = dec, big.mark = big, scientific = F), billion),
+      x > 1e6,
+      paste(format(round(x/1e6, digits = dig), nsmall = dig,
+                   decimal.mark = dec, big.mark = big, scientific = F), million),
+      x > 1e3,
+      paste(format(round(x/1e3, digits = dig), nsmall = dig,
+                   decimal.mark = dec, big.mark = big, scientific = F), thousand),
+      default = format(round(x, dig), nsmall = dig, scientific = F)
     )
+  } else {
+    x
+  }
 }
diff --git a/R/navbar_df_info_module.R b/R/navbar_df_info_module.R
@@ -14,8 +14,8 @@ navbar_df_info_server <- function(id, input_metadata, app_session) {
       tagList(
         h5(input_metadata()$name),
         p('Rows/Columns:',
-          paste(input_metadata()$nrow |> f_num(dec = '.', big = ',', dig = 3), '/',
-                input_metadata()$ncol |> f_num(dec = '.', big = ','))
+          paste(input_metadata()$nrow |> f_num(dig = 1), '/',
+                input_metadata()$ncol |> f_num())
         ),
         p("Columns with NA's:", input_metadata()$n_nas),
         p('Size (MB):', (input_metadata()$size)),

diff --git a/R/rename_cols_module.R b/R/rename_cols_module.R
@@ -0,0 +1,61 @@
+
+# ui --------------------------------------------------------------------------
+rename_cols_ui <- function(id) {
+  ns <- NS(id)
+
+  card(
+    card_header('Rename Columns', class = 'mini-header'),
+    card_body(
+      uiOutput(ns('ui_var_sel')),
+      textInput(ns('txt_new_name'), 'New name'),
+    ),
+    card_footer(btn_task(ns('btn_rename'), 'Rename Variable', icon('check')))
+  )
+
+}
+
+# server ----------------------------------------------------------------------
+rename_cols_server <- function(id, input_df) {
+  moduleServer(id, function(input, output, session) {
+    ns <- NS(id)
+
+    df <- reactiveValues()
+    observe({
+      req(input_df())
+      df$df_active <- input_df()
+    })
+
+    df_names <- reactive({
+      req(df$df_active)
+      df$df_active |> names()
+    })
+
+    output$ui_var_sel <- renderUI({
+      req(df$df_active)
+      selectInput(ns('vars_sel'), 'Variable', c('', df_names()))
+    })
+
+    observe({
+      req(input$vars_sel, input$txt_new_name, df$df_active)
+      if(input$vars_sel |> length() == 0){
+        msg('Select at least one variable')
+      } else {
+        if(is_valid_name(input$txt_new_name) &&
+           input$txt_new_name %notin% df_names()){
+          names(df$df_active)[names(df$df_active) == input$vars_sel] <- input$txt_new_name
+          msg('Rename columns: OK')
+
+          output$ui_var_sel <- renderUI({
+            selectInput(ns('vars_sel'), 'Variable', c('', df_names()))
+          })
+
+        } else {
+          msg_error('New name is not valid or already in use')
+        }
+
+      }
+    }) |> bindEvent(input$btn_rename)
+
+    return(list(df_rename_cols = reactive(df$df_active)))
+  })
+}
diff --git a/R/sidebar_module.R b/R/sidebar_module.R
@@ -25,8 +25,8 @@ sidebar_server <- function(id, input_metadata, app_session) {
       tagList(
         h5(input_metadata()$name),
         p('Rows/Columns:',
-          paste(input_metadata()$nrow |> f_num(dec = '.', big = ',', dig = 3), '/',
-                input_metadata()$ncol |> f_num(dec = '.', big = ','))
+          paste(input_metadata()$nrow |> f_num(dig = 1),
+                '/', input_metadata()$ncol |> f_num())
         ),
         p("Columns with NA's:", input_metadata()$n_nas),
         p('Size (MB):', (input_metadata()$size)),

diff --git a/R/spada_server.R b/R/spada_server.R
@@ -176,8 +176,7 @@ spada_server <- function(datasets){
                     mod_pE_convert_cols$df_convert_cols_trigger())
 
     # order rows events ---------------------------
-    mod_pE_order_rows <- order_rows_server('pE_filter_order_rows',
-                                           reactive(df$df_active))
+    mod_pE_order_rows <- order_rows_server('pE_order_rows', reactive(df$df_active))
 
     # update df_active
     observe({
@@ -188,8 +187,7 @@ spada_server <- function(datasets){
     }) |> bindEvent(mod_pE_order_rows$df_order_rows())
 
     # order cols events ---------------------------
-    mod_pE_order_cols <- order_cols_server('pE_filter_order_cols',
-                                          reactive(df$df_active))
+    mod_pE_order_cols <- order_cols_server('pE_order_cols', reactive(df$df_active))
     # update df_active
     observe({
       req(mod_pE_order_cols$df_order_cols())
@@ -198,6 +196,15 @@ spada_server <- function(datasets){
 
     }) |> bindEvent(mod_pE_order_cols$df_order_cols())
 
+    # rename cols events ---------------------------
+    mod_pE_rename_cols <- rename_cols_server('pE_rename_cols', reactive(df$df_active))
+    # update df_active
+    observe({
+      req(mod_pE_rename_cols$df_rename_cols())
+      df$df_active <- mod_pE_rename_cols$df_rename_cols()
+
+    }) |> bindEvent(mod_pE_rename_cols$df_rename_cols())
+
     # reset df active ---------------------------
     observe({
       df$df_active <- copy(dt_react$data[[df$df_active_name]])

diff --git a/R/spada_ui.R b/R/spada_ui.R
@@ -96,10 +96,17 @@ spada_ui <- function(){
                    nav_panel(
                      'Order',
                      layout_column_wrap(
-                       order_rows_ui('pE_filter_order_rows'),
-                       order_cols_ui('pE_filter_order_cols')
+                       order_rows_ui('pE_order_rows'),
+                       order_cols_ui('pE_order_cols')
                      )
-                   )
+                   ),
+                   nav_panel(
+                     'Rename',
+                     layout_column_wrap(
+                       rename_cols_ui('pE_rename_cols'),
+                       card()
+                     )
+                   ),
                  )
                )
              ),