News 2025.02.01-1

NEWS.md

@@ -22,6 +22,27 @@ editor_options:
 
 7 - Models: linear model, logistic regression, Kmeans, Trees
 
+## 2025.02.01-1
+
+Only visual and formatting changes.
+
+### Improvements
+
+1 - **Convert Cols, Data Overview and Sidebar** modules: background color receive object bg_color
+
+2 - **Correlation, Normality Test and Z Test** modules: sidebars color now with bg_color object and stati_card with blue color
+
+3 - **Descriptive Stats** module: gain digits input and f_num for format values
+
+4 - **f_num** function: now with nsmall inside format function for number of decimal digits
+
+5 - **Spada_ui**: now with color objects instead of hex code
+
+6 - **stats Table** module: now values with f_num instead of f_dec function
+
+7 - **utils.R**: new function stati_card (basically shinyWidgets::statiCard with default values)
+and colors in objects to use across several places
+
 ## 2025.01.29-1
 
 ### Bug Fixes

R/convert_cols_module.R

@@ -122,7 +122,7 @@ convert_cols_server <- function(id, input_df, input_df_trigger) {
             use_pagination = F,
             use_highlight = T,
             use_compact_mode = T) |>
-          tab_options(table.background.color = '#f9f9f9')
+          tab_options(table.background.color = bg_color)
       }
     })
 

R/correlation_module.R

@@ -6,14 +6,15 @@ correlation_ui <- function(id) {
     full_screen = T,
     card_header('Correlation Test', class = 'mini-header'),
     layout_sidebar(
-      bg = '#02517d',
-      sidebar = sidebar(uiOutput(ns('parameters')), bg = '#e3e3e4'),
+      bg = main_color,
+      sidebar = sidebar(uiOutput(ns('parameters')), bg = sidebar_color),
       navset_card_pill(
         nav_panel(
           'Test',
           card(
             layout_sidebar(
               sidebar = sidebar(
+                bg = sidebar_color,
                 width = 400,
                 h5('Parameters', style = 'margin-bottom: -18px;'),
                 radioButtons(ns('radio_method'), 'Method',
@@ -143,25 +144,19 @@ correlation_server <- function(id, df, df_metadata, color_fill) {
     output$conditional_staticard_cor <- renderUI({
       req(cor_results_gt())
       tagList(
-        statiCard(cor_test$results |>
+        stati_card(cor_test$results |>
                   filter(results %in% c('estimate.cor', 'estimate.tau',
                   'estimate.rho')) |>
                   pull(values) |>
                   as.numeric() |>
                   f_num(dig = 3),
-                  subtitle = 'Correlation',
-                  left = T,
-                  animate = T,
-                  duration = 30),
-        statiCard(cor_test$results |>
+                  'Correlation'),
+        stati_card(cor_test$results |>
                   filter(results %in% c('p.value')) |>
                   pull(values) |>
                   as.numeric() |>
                   f_num(dig = 3),
-                  subtitle = 'p value',
-                  left = T,
-                  animate = T,
-                  duration = 30)
+                  'p value')
       )
     })
 

R/data_overview_module.R

@@ -53,7 +53,7 @@ data_overview_server <- function(id, df, triggers) {
             use_text_wrapping = F,
             use_page_size_select = T
           ) |>
-          tab_options(table.background.color = '#f9f9f9')
+          tab_options(table.background.color = bg_color)
     })
   })
 }

R/descriptive_stats_module.R

@@ -5,9 +5,9 @@ descriptive_stats_ui <- function(id) {
   card(
     full_screen = T,
     card_header('Descriptive Statistics', class = 'mini-header'),
-    layout_sidebar(bg = '#02517d',
+    layout_sidebar(bg = main_color,
       sidebar = sidebar(
-        bg = '#e3e3e4',
+        bg = sidebar_color,
         uiOutput(ns('parameters')),
         checkboxGroupInput(
           ns('xg_central_tendency'),
@@ -22,6 +22,7 @@ descriptive_stats_ui <- function(id) {
             'Standard Deviation' = 'sd'),
           c('min', 'max', 'IQR', 'range', 'var', 'sd')
         ),
+        numericInput(ns('table_digits'), 'Digits', 2, 0, 9, 1),
         btn_task(ns('btn_stats'), 'Generate Table', icon('gear'))
       ),
       navset_card_pill(
@@ -64,17 +65,19 @@ descriptive_stats_server <- function(id, df) {
       req(input$sel_var)
       desc_stats <- list()
 
+      fmt_digits <- min(max(0, input$table_digits), 9)
+
       # central tendency
       if('mean' %in% input$xg_central_tendency){
         desc_stats$Mean <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) mean(x, na.rm = T) else NA })
+          \(x) {if(x |> is.numeric()) mean(x, na.rm = T) |> f_num(dig = fmt_digits) else NA })
       }
 
       if('median' %in% input$xg_central_tendency){
         desc_stats$Median <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) median(x, na.rm = T) else NA })
+          \(x) {if(x |> is.numeric()) median(x, na.rm = T) |> f_num(dig = fmt_digits)  else NA })
       }
 
       if('mode' %in% input$xg_central_tendency){
@@ -83,7 +86,7 @@ descriptive_stats_server <- function(id, df) {
           \(x) {if(x |> is.numeric() ||
                    x |> is.character() ||
                    x |> is.factor()){
-            x_mode <- Mode(x, na.rm = T)
+            x_mode <- Mode(x, na.rm = T) |> f_num(dig = fmt_digits)
             if(is.na(x_mode) |> all()) NA else paste(x_mode, collapse = ' | ')
           } else { NA }
         })
@@ -93,27 +96,27 @@ descriptive_stats_server <- function(id, df) {
       if('min' %in% input$xg_dispersion){
         desc_stats$Min <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) mina(x) else NA })
+          \(x) {if(x |> is.numeric()) mina(x) |> f_num(dig = fmt_digits) else NA })
       }
 
       if('max' %in% input$xg_dispersion){
         desc_stats$Max <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) mana(x) else NA })
+          \(x) {if(x |> is.numeric()) mana(x) |> f_num(dig = fmt_digits) else NA })
       }
 
       if('IQR' %in% input$xg_dispersion){
         desc_stats$IQR <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) IQR(x, na.rm = T) else NA })
+          \(x) {if(x |> is.numeric()) IQR(x, na.rm = T) |> f_num(dig = fmt_digits) else NA })
       }
 
       if('range' %in% input$xg_dispersion){
         desc_stats$Range <- sapply(
           df_stats(),
           \(x) {
             if(x |> is.numeric()){
-              paste('[', range(x), ']', collapse = '--->')
+              paste('[', range(x) |> f_num(dig = fmt_digits) , ']', collapse = '--->')
             } else { NA }
             }
           )
@@ -122,13 +125,13 @@ descriptive_stats_server <- function(id, df) {
       if('var' %in% input$xg_dispersion){
         desc_stats$Variance <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) var(x, na.rm = T) else NA })
+          \(x) {if(x |> is.numeric()) var(x, na.rm = T) |> f_num(dig = fmt_digits) else NA })
       }
 
       if('sd' %in% input$xg_dispersion){
         desc_stats[['Standard Deviation']] <- sapply(
           df_stats(),
-          \(x) {if(x |> is.numeric()) sd(x, na.rm = T) else NA })
+          \(x) {if(x |> is.numeric()) sd(x, na.rm = T) |> f_num(dig = fmt_digits) else NA })
       }
 
       desc_stats
@@ -145,7 +148,8 @@ descriptive_stats_server <- function(id, df) {
     output$gt_stats <- render_gt({
       req(gt_stats)
       gt_stats() |>
-        sub_missing() |>
+        sub_missing(missing_text = '-') |>
+        sub_values(values = 'NA', replacement = '-') |>
         opt_interactive()
     })
 

R/f_num.R

@@ -1,41 +1,41 @@
-
-#' Format number with abreviation and separators
-#'
-#' Return is character class
-#'
-#' @param x Object with values
-#' @param big Thousand separator
-#' @param dec Decimal separator
-#' @param thousand Abreviation for thousands
-#' @param million Abreviation for millions
-#' @param billion Abreviation for billions
-#' @param dig Digits after decimal mark
-#'
-#' @examples
-#' f_num(12345678956, billion = 'G')
-#' f_num(512347896, million = 'Mi')
-#' f_num(9995198, thousand = 'm', dig = 3, dec = ',', big = '.')
-#' f_num(55566312345678956, billion = 'G')
-#' f_num(Inf)
-#' f_num(-Inf)
-#'
-#' @export
-#' @importFrom data.table fcase
-
-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),
-                 decimal.mark = dec, big.mark = big, scientific = F), billion),
-    x > 1e6,
-    paste(format(round(x/1e6, digits = dig),
-                 decimal.mark = dec, big.mark = big, scientific = F), million),
-    x > 1e3,
-    paste(format(round(x/1e3, digits = dig),
-                 decimal.mark = dec, big.mark = big, scientific = F), thousand),
-    default = format(round(x, dig), scientific = F)
-    )
-}
+
+#' Format number with abreviation and separators
+#'
+#' Return is character class
+#'
+#' @param x Object with values
+#' @param big Thousand separator
+#' @param dec Decimal separator
+#' @param thousand Abreviation for thousands
+#' @param million Abreviation for millions
+#' @param billion Abreviation for billions
+#' @param dig Digits after decimal mark
+#'
+#' @examples
+#' f_num(12345678956, billion = 'G')
+#' f_num(512347896, million = 'Mi')
+#' f_num(9995198, thousand = 'm', dig = 3, dec = ',', big = '.')
+#' f_num(55566312345678956, billion = 'G')
+#' f_num(Inf)
+#' f_num(-Inf)
+#'
+#' @export
+#' @importFrom data.table fcase
+
+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)
+    )
+}

R/normality_test_module.R

@@ -5,8 +5,8 @@ normality_test_ui <- function(id) {
   card(
     full_screen = T,
     card_header('Normality Test', class = 'mini-header'),
-    layout_sidebar(bg = '#02517d',
-      sidebar = sidebar(uiOutput(ns('parameters')), bg = '#e3e3e4'),
+    layout_sidebar(bg = main_color,
+      sidebar = sidebar(uiOutput(ns('parameters')), bg = sidebar_color),
       navset_card_pill(
         nav_panel(
           'Histogram',
@@ -199,24 +199,18 @@ normality_test_server <- function(id, df, df_metadata, color_fill, color_line) {
     output$conditional_staticard_ks <- renderUI({
       req(ks_results())
       tagList(
-        statiCard(ks_results()$results |>
-                    filter(results %in% c('statistic.D')) |>
-                    pull(values) |>
-                    as.numeric() |>
-                    f_num(dig = 5),
-                  subtitle = 'Statistic D (test value)',
-                  left = T,
-                  animate = T,
-                  duration = 30),
-        statiCard(ks_results()$results |>
-                    filter(results %in% c('p.value')) |>
-                    pull(values) |>
-                    as.numeric() |>
-                    f_num(dig = 5),
-                  subtitle = 'p value',
-                  left = T,
-                  animate = T,
-                  duration = 30)
+        stati_card(ks_results()$results |>
+                   filter(results %in% c('statistic.D')) |>
+                   pull(values) |>
+                   as.numeric() |>
+                   f_num(dig = 5),
+                   'Statistic D (test value)'),
+        stati_card(ks_results()$results |>
+                   filter(results %in% c('p.value')) |>
+                   pull(values) |>
+                   as.numeric() |>
+                   f_num(dig = 5),
+                   'p value')
       )
     })
 
@@ -288,24 +282,18 @@ normality_test_server <- function(id, df, df_metadata, color_fill, color_line) {
     output$conditional_staticard_sw <- renderUI({
       req(sw_results())
       tagList(
-        statiCard(sw_results() |>
-                    filter(results %in% c('statistic.W')) |>
-                    pull(values) |>
-                    as.numeric() |>
-                    f_num(dig = 5),
-                  subtitle = 'Statistic W (test value)',
-                  left = T,
-                  animate = T,
-                  duration = 30),
-        statiCard(sw_results() |>
-                    filter(results %in% c('p.value')) |>
-                    pull(values) |>
-                    as.numeric() |>
-                    f_num(dig = 5),
-                  subtitle = 'p value',
-                  left = T,
-                  animate = T,
-                  duration = 30)
+        stati_card(sw_results() |>
+                   filter(results %in% c('statistic.W')) |>
+                   pull(values) |>
+                   as.numeric() |>
+                   f_num(dig = 5),
+                   'Statistic W (test value)'),
+        stati_card(sw_results() |>
+                   filter(results %in% c('p.value')) |>
+                   pull(values) |>
+                   as.numeric() |>
+                   f_num(dig = 5),
+                   'p value')
       )
     })
 

R/sidebar_module.R

@@ -4,7 +4,7 @@ sidebar_ui <- function(id) {
   ns <- NS(id)
 
   sidebar(
-    bg = '#e3e3e4',
+    bg = sidebar_color,
     open = F,
     accordion(
       open = T,