News 2025.02.25-1

NEWS.md

@@ -6,7 +6,7 @@ editor_options:
 
 # Spada 0.1.0.9000 (development version)
 
-## TO DO
+## 0.1.0 Milestone
 
 1 - Allow filter multiple conditions
 
@@ -20,6 +20,24 @@ editor_options:
 
 6 - Models: linear model, logistic regression, Kmeans, Trees
 
+## 2025.02.25-1
+
+Highlights: 
+
+### Improvements
+
+1 - **Calculate Cols** module: now allows to calculate with groupby 
+
+2 - **Rename Cols** module: now allows to rename multiple variables together
+
+3 - **spada.R**: new dependencie: tools package
+
+4 - **spada_themes.R**: new css for startup screen
+
+5 - **spada_ui.R**: change startup screen css (now in spada_themes) and busyindicator options (now the spinner is 'bars2')
+
+6 - **utils.R**: removed Range function (because it returns 2 values), correct a typo in ceilling function (now ceiling) and update in get_help_file for better visual
+
 ## 2025.02.19-1
 
 Highlights: New **Calculate Cols** module, better internal control over changes in datasets and many small visual improvements

R/calculate_cols_module.R

@@ -1,5 +1,4 @@
 
-
 # ui --------------------------------------------------------------------------
 calculate_cols_ui <- function(id) {
   ns <- NS(id)
@@ -8,8 +7,9 @@ calculate_cols_ui <- function(id) {
     card_header('Apply Function', class = 'mini-header'),
     card_body(
       uiOutput(ns('ui_var_sel')),
-      textInput(ns('txt_new_name'), 'New name'),
-      uiOutput(ns('ui_fun_sel'))
+      textInput(ns('txt_new_name'), 'New variable name'),
+      uiOutput(ns('ui_fun_sel')),
+      uiOutput(ns('ui_var_groupby'))
     ),
     card_footer(btn_task(
       ns('btn_apply_fun'), 'Apply', icon('check')
@@ -35,6 +35,13 @@ calculate_cols_server <- function(id, input_df) {
       selectInput(ns('vars_sel'), 'Variable', c('', df_names()))
     })
 
+    # render variables group -------------------------------------------------
+    output$ui_var_groupby <- renderUI({
+      selectizeInput(ns('vars_groupby'), 'Group by', c('None' = NULL, df_names()),
+                     multiple = T,
+                     options = list(plugins = list('remove_button', 'clear_button')))
+    })
+
     # suggest name for new variable -------------------------------------------
     observe({
       req(input$vars_sel)
@@ -48,24 +55,20 @@ calculate_cols_server <- function(id, input_df) {
       obj_type(df$df_active[[input$vars_sel]])
     })
 
-
     output$ui_fun_sel <- renderUI({
       req(input$vars_sel)
-      if (selected_var_type() == 'numeric') {
-        selectInput(ns('fun'), 'Choose a function', choices = math_funs)
-      } else if (selected_var_type() == 'char'){
-        selectInput(ns('fun'), 'Choose a function', choices = char_funs)
-      } else if (selected_var_type() == 'date'){
-        selectInput(ns('fun'), 'Choose a function', choices = date_funs)
-      } else if (selected_var_type() == 'logical'){
-        selectInput(ns('fun'), 'Choose a function', choices = logical_funs)
-      } else if (selected_var_type() == 'factor'){
-        selectInput(ns('fun'), 'Choose a function', choices = factor_funs)
-      } else if (selected_var_type() == 'complex'){
-        selectInput(ns('fun'), 'Choose a function', choices = complex_funs)
-      } else {
-        selectInput(ns('fun'), 'Choose a function', choices = character(0))
-      }
+
+      selectInput(ns('fun'), 'Choose a function', choices = switch(
+        selected_var_type(),
+        "numeric"  = math_funs,
+        "char"     = char_funs,
+        "date"     = date_funs,
+        "logical"  = logical_funs,
+        "factor"   = factor_funs,
+        "complex"  = complex_funs,
+        character(0)
+      ))
+
     })
 
     observe({
@@ -78,10 +81,11 @@ calculate_cols_server <- function(id, input_df) {
 
           temp <- copy(df$df_active)
 
-          temp[, new_var := fun(var1), env = list(
+          temp[, new_var := fun(var1), by = groupby, env = list(
             new_var = input$txt_new_name,
             fun = input$fun,
-            var1 = input$vars_sel
+            var1 = input$vars_sel,
+            groupby = input$vars_groupby |> as.list()
           )]
 
           df$df_active <- copy(temp)

R/rename_cols_module.R

@@ -3,13 +3,56 @@
 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'),
+  layout_column_wrap(
+    card(
+      card_header('Rename Column', 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')))
     ),
-    card_footer(btn_task(ns('btn_rename'), 'Rename Variable', icon('check')))
+    card(
+      card_header('Rename Multiple Columns', class = 'mini-header'),
+      card_body(
+        uiOutput(ns('ui_var_sel_multi')),
+        radioButtons(ns('rename_method'), 'Rename Method',
+                     choices = c('Add Prefix/Suffix' = 'prefix_suffix',
+                                 'Apply Function' = 'function',
+                                 'Replace Part' = 'replace',
+                                 'Remove Part' = 'remove')),
+
+        conditionalPanel(
+          condition = sprintf("input['%s'] == 'prefix_suffix'", ns('rename_method')),
+          textInput(ns('txt_new_name_multi'), 'New name part'),
+          radioButtons(ns('part_position'), 'Part Position',
+                       choices = c('Prefix' = 'prefix', 'Suffix' = 'suffix')),
+          radioButtons(ns('name_separator'), 'Separator',
+                       choices = c('Underscore (_)' = '_', 'Dot (.)' = '.', 'None' = ''))
+        ),
+
+        conditionalPanel(
+          condition = sprintf("input['%s'] == 'function'", ns('rename_method')),
+          selectInput(ns('name_function'), 'Function to Apply',
+                      choices = c('Upper Case' = 'toupper',
+                                  'Lower Case' = 'tolower',
+                                  'Title Case' = 'toTitleCase'))
+        ),
+
+        conditionalPanel(
+          condition = sprintf("input['%s'] == 'replace'", ns('rename_method')),
+          textInput(ns('txt_replace_part'), 'Part to Replace'),
+          textInput(ns('txt_replace_new_part'), 'New Part'),
+        ),
+
+        conditionalPanel(
+          condition = sprintf("input['%s'] == 'remove'", ns('rename_method')),
+          textInput(ns('txt_remove_part'), 'Part to Remove')
+        ),
+
+      ),
+      card_footer(btn_task(ns('btn_rename_multi'), 'Rename Variables', icon('check')))
+    )
   )
 }
 
@@ -26,6 +69,7 @@ rename_cols_server <- function(id, input_df) {
       df$df_active <- input_df()
     })
 
+    # rename 1 variable ------------------------------------------------------
     output$ui_var_sel <- renderUI({
       selectInput(ns('vars_sel'), 'Variable', c('', df_names()))
     })
@@ -43,16 +87,73 @@ rename_cols_server <- function(id, input_df) {
           setnames(temp, input$vars_sel, input$txt_new_name)
 
           df$df_active <- copy(temp)
-		  rm(temp)
 
-          msg('Rename columns: OK')
+          rm(temp)
+
+          msg('Rename column: OK')
         } else {
           msg_error('New name is not valid or already in use')
         }
 
       }
     }) |> bindEvent(input$btn_rename)
 
+    # rename multiple veriables -----------------------------------------------
+    output$ui_var_sel_multi <- renderUI({
+      selectizeInput(ns('vars_sel_multi'), 'Variables', c('', df_names()),
+                  multiple = T,
+                  options = list(plugins = list('remove_button', 'clear_button')))
+    })
+
+    observe({
+      req(input$vars_sel_multi, df$df_active)
+      if(input$vars_sel_multi |> length() == 0){
+        msg('Select at least one variable')
+      } else {
+
+        temp <- copy(df$df_active)
+        new_names <- input$vars_sel_multi
+
+        if (input$rename_method == 'prefix_suffix') {
+          req(input$txt_new_name_multi)
+          if (input$part_position == 'prefix') {
+            new_names <- paste0(input$txt_new_name_multi,
+                                input$name_separator, new_names)
+          } else if (input$part_position == 'suffix'){
+            new_names <- paste0(new_names, input$name_separator,
+                                input$txt_new_name_multi)
+          }
+        } else if (input$rename_method == 'function') {
+          new_names <- sapply(new_names, match.fun(input$name_function))
+        } else if (input$rename_method == 'replace') {
+          req(input$txt_replace_part, input$txt_replace_new_part)
+          new_names <- gsub(input$txt_replace_part, input$txt_replace_new_part,
+                            new_names, fixed = TRUE)
+        } else if (input$rename_method == 'remove') {
+          req(input$txt_remove_part)
+          new_names <- gsub(input$txt_remove_part, '', new_names, fixed = TRUE)
+        }
+
+        # Validação de nomes únicos e válidos --------------------------------
+        if (is_valid_name(new_names) |> all()) {
+
+          if(all(new_names %in% df_names())) {
+            msg('No changes to apply')
+          } else if (any(new_names %in% df_names())) {
+            msg_error('Some new names already in use')
+          } else {
+            setnames(temp, input$vars_sel_multi, new_names)
+            df$df_active <- copy(temp)
+            msg('Rename columns: OK')
+            rm(temp)
+          }
+        } else {
+          msg_error('New names are not valid')
+        }
+      }
+    }) |> bindEvent(input$btn_rename_multi)
+
+    # return of module --------------------------------------------------------
     return(list(df_rename_cols = reactive(df$df_active)))
   })
 }

R/spada.R

@@ -48,6 +48,8 @@
 #' @importFrom stats cor lm sd var median rnorm IQR cor.test dnorm ks.test
 #'             qnorm qqline qqnorm shapiro.test
 #'
+#' @importFrom tools toTitleCase
+#'
 #' @importFrom utils object.size head
 
 spada <- function(...) {

R/spada_themes.R

@@ -6,6 +6,7 @@ bg_color <- '#f9f9f9'
 secondary <- '#0072B2'
 sucess <- '#009E73'
 
+startup_text_color <- '#FFFFFF'
 # palettes --------------------------------------------------------------------
 gray_palette <- c('#ffffff', '#585858', '#232323')
 blue_palette <- c('#ffffff', '#096691', '#134359')
@@ -30,9 +31,30 @@ theme_basic_rules <- as_sass(
          grad5 = '#5fa3c2',
          grad6 = '#4e96b6',
          navbar_bg = '#007bb5',
-         stati_card_text = '#ffffff'
+         stati_card_text = '#ffffff',
+         startup_bg = main_color
     ),
     "
+
+      .startup-screen {
+        background-color: $startup_bg;
+        width: 500000px;
+        height: 250px;
+        /*border-radius: 15px 50px 15px 50px;
+        border-style: dotted;
+        border-color: white;*/
+      }
+
+      .startup-screen h1 {
+        font-family: Times;
+        font-size: 150px;
+      }
+
+      .startup-screen h3 {
+        font-family: Times;
+        font-size: 30px;
+      }
+
       .navbar {
         background: $navbar_bg !important;
         height: 45px !important;

R/spada_ui.R

@@ -2,19 +2,23 @@
 # Function with the ui of spada.R
 spada_ui <- function(){
   tagList(
+
+    busyIndicatorOptions(
+      spinner_type = 'bars2',
+      spinner_color = main_color,
+      fade_opacity = '0.1'
+    ),
+
     useBusyIndicators(),
 
     busy_start_up(
-      loader = spin_epic('orbit', color = '#FFFFFF'),
+      loader = spin_epic('orbit', color = startup_text_color),
       text = tagList(
-        h1('Spada',
-        style = "font-family: 'Times'; font-size: 120px;"),
-        h3('R > Shiny > You',
-           style = "font-family: 'Times'; font-size: 20px;")
+        div(class = 'startup-screen', h1('Spada'), h3('R > Shiny > You'))
       ),
       mode = 'auto',
       timeout = 1200,
-      color = '#FFFFFF',
+      color = startup_text_color,
       background = main_color
     ),
 
@@ -94,10 +98,7 @@ spada_ui <- function(){
                    ),
                    nav_panel(
                      'Rename',
-                     layout_column_wrap(
-                       rename_cols_ui('pE_rename_cols'),
-                       card()
-                     )
+                     rename_cols_ui('pE_rename_cols')
                    ),
                    nav_panel(
                      'Calculate',

R/utils.R

@@ -14,7 +14,7 @@ math_funs <- c(
     'First' = 'fina',
     'Last' = 'lana',
     'Lag' = 'shift',
-    'Range' = 'range',
+    # 'Range' = 'range',
     'IQR' = 'IQR',
     'Skewness' = 'Skew',
     'Kurtosis' = 'Kurt',
@@ -27,7 +27,7 @@ math_funs <- c(
     'Log' = 'log',
     'Log2' = 'log2',
     'Log10' = 'log10',
-    'Ceilling' = 'ceilling',
+    'Ceiling' = 'ceiling',
     'Floor' = 'floor',
     'Trunc' = 'trunc',
     'Signif' = 'signif',
@@ -306,8 +306,11 @@ ttip <- function(TRIGGER, ..., ID = NULL, PLACE = 'top'){
 
 # get function help -----------------------------------------------------------
 get_help_file <- function(pak, fun){
-  utils::capture.output(
-    tools::Rd2HTML(tools::Rd_db(pak)[[paste0(fun, '.Rd')]])
+  paste(
+    utils::capture.output(
+      tools::Rd2HTML(tools::Rd_db(pak)[[paste0(fun, '.Rd')]])
+    ),
+    collapse = '\n'
   )
 }