diff --git a/.Rprofile b/.Rprofile index 3094056..206cfbd 100644 --- a/.Rprofile +++ b/.Rprofile @@ -14,7 +14,10 @@ if(interactive()){ library(data.table) library(dplyr) library(conflicted) + library(shinyWidgets) + library(shinybusy) conflicted::conflict_prefer('filter', 'dplyr') + conflicted::conflict_prefer('between', 'data.table') } diff --git a/DESCRIPTION b/DESCRIPTION index 98f7a70..5b3f22a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,6 +16,7 @@ Imports: dplyr (>= 1.1.4), gt (>= 0.11.1), shiny (>= 1.9.1), + shinybusy (>= 0.3.3), shinyWidgets (>= 0.8.7) Encoding: UTF-8 LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 37645bd..e689fde 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -72,12 +72,18 @@ importFrom(gt,fmt_number) importFrom(gt,fmt_percent) importFrom(gt,gt) importFrom(gt,gt_output) +importFrom(gt,gtsave) importFrom(gt,opt_interactive) importFrom(gt,render_gt) importFrom(gt,sub_missing) importFrom(gt,tab_options) importFrom(shinyWidgets,colorPickr) +importFrom(shinyWidgets,dropdownButton) +importFrom(shinyWidgets,radioGroupButtons) +importFrom(shinyWidgets,show_toast) importFrom(shinyWidgets,updateColorPickr) +importFrom(shinybusy,busy_start_up) +importFrom(shinybusy,spin_epic) importFrom(stats,IQR) importFrom(stats,cor) importFrom(stats,cor.test) diff --git a/NEWS.md b/NEWS.md index a0c0e24..f542db6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -22,6 +22,24 @@ editor_options: 7 - Models: linear model, logistic regression, Kmeans, Trees +## 2025.01.20-1 + +### Improvements + +1 - **Startup page**: now with startup page with shinybusy package (new dependencie) + +2 - **radioGroupButtons**: change some radioButtons (shiny) for radioGroupButtons (shinyWidgets) in data_overview_module and exploratory_module for better look + +3 - **Page config** module: colorPickr now with 'save' mode for better reset of values and other visual changes fo better look + +4 - **New Save gt** module: now the gt table can be saved to hmtl, rtf and docx (gt::gt_save function) + +5 - **Stats table** module: check for digits if out of range (0, 9) and new save_gt module in this module + +6 - **Descriptive Stats** module: insert req to generate stats and new save_gt_module in this module + +7 - **show_toast**: change showNotification (shiny) for show_toast (shinyWidgets) for better look + ## 2025.01.17-1 ### Improvements diff --git a/R/data_overview_module.R b/R/data_overview_module.R index a58af3b..d623bf0 100644 --- a/R/data_overview_module.R +++ b/R/data_overview_module.R @@ -11,9 +11,10 @@ data_overview_ui <- function(id) { "), fluidRow( column(2, numericInput(ns('size_sample'), 'Number of rows', 100, 100, 1e4, 100)), - column(2, radioButtons( + column(2, radioGroupButtons( ns('radio_sample'), 'Show', - c('First rows' = 'first', 'Sample' = 'sample'), inline = T)), + c('First rows' = 'first', 'Sample' = 'sample'), + size = 'sm', individual = T)), style = "margin-top: -16px !important; margin-bottom: -16px !important;" ), ) diff --git a/R/descriptive_stats_module.R b/R/descriptive_stats_module.R index 407a525..e8418cd 100644 --- a/R/descriptive_stats_module.R +++ b/R/descriptive_stats_module.R @@ -29,7 +29,9 @@ descriptive_stats_ui <- function(id) { 'Stats', card(full_screen = T, card_body( - gt_output(ns('gt_stats'))) + gt_output(ns('gt_stats')), + uiOutput(ns('conditional_save_gt')) + ) ) ) ) @@ -53,6 +55,7 @@ descriptive_stats_server <- function(id, df) { }) df_stats <- reactive({ + req(input$sel_var) subset(df(), select = input$sel_var) }) @@ -118,13 +121,26 @@ descriptive_stats_server <- function(id, df) { desc_stats }) - output$gt_stats <- render_gt( + gt_stats <- reactive({ data.frame( Measures = names(desc_stats()), do.call(rbind, desc_stats()) ) |> - gt() |> + gt() + }) |> bindEvent(input$btn_stats) + + output$gt_stats <- render_gt({ + req(gt_stats) + gt_stats() |> opt_interactive() - ) |> bindEvent(input$btn_stats) + }) + + save_gt_server('pA_desciptive_stats_save_gt', gt_stats) + + output$conditional_save_gt <- renderUI({ + req(gt_stats()) + save_gt_ui(ns('pA_desciptive_stats_save_gt')) + }) + }) } diff --git a/R/exploratory_module.R b/R/exploratory_module.R index 7c3382f..6aba1e6 100644 --- a/R/exploratory_module.R +++ b/R/exploratory_module.R @@ -30,14 +30,14 @@ card( card_footer( fluidRow( column(8, - radioButtons( + radioGroupButtons( ns('radio_dist_plot'), 'Plot type:', c('Histogram' = 'hist', 'Boxplot' = 'boxplot', 'Boxplot by Groups' = 'boxplot_group', 'Dots' = 'dots', - 'Barplot' = 'barplot'),inline = T)), + 'Barplot' = 'barplot'), size = 'sm', individual = T)), column(2, numericInput(ns('var_percentile'), 'Percentile', 50, 0, 100, 5)), column(2, conditionalPanel( condition = sprintf("input['%s'] == 'hist'", ns('radio_dist_plot')), @@ -66,9 +66,9 @@ card( 'Table', full_screen = T, card_body( - radioButtons(ns('table_type'), 'Table type:', + radioGroupButtons(ns('table_type'), 'Table type:', c('1 Variable' = '1d', - '2 Variables' = '2d'), inline = T), + '2 Variables' = '2d'), size = 'sm', individual = T), verbatimTextOutput(ns('table'), placeholder = T), ) ), @@ -91,10 +91,12 @@ card( plotOutput(ns('g_lm_resid')), card_footer( layout_column_wrap( - radioButtons(ns('radio_lm_resid'), 'Plot type:', + radioGroupButtons(ns('radio_lm_resid'), 'Plot type:', c('Histogram' = 'hist', 'Boxplot' = 'boxplot', - 'Dots' = 'dots'), inline = T), - btn_task(ns('btn_lm_resid'), 'Plot residuals', icon('chart-simple'))) + 'Dots' = 'dots'), size = 'sm', individual = T), + btn_task(ns('btn_lm_resid'), 'Plot residuals', icon('chart-simple')) + ), + div(style = "margin-bottom: -24px !important;"), ) ), )), diff --git a/R/page_config_module.R b/R/page_config_module.R index 396cf16..46064d3 100644 --- a/R/page_config_module.R +++ b/R/page_config_module.R @@ -6,24 +6,52 @@ page_config_ui <- function(id) { value = 'config', title = 'Config', icon = bs_icon('sliders2'), - card(style = 'background-color: #02517d;', layout_columns( - col_widths = c(9, 3), card(card_body( - h4('Colors'), - layout_columns( - col_widths = c(3, 3, 3), - colorPickr(inputId = ns('sel_fill'), label = 'Fill color:', - selected = '#5cacee', update = 'changestop'), - colorPickr(inputId = ns('sel_line'),label = 'Line color', - selected = '#EE7942', update = 'changestop'), - btn_task(ns('reset'), 'Reset', style = 'margin-top: 20px !important;') + card( + style = 'background-color: #02517d;', + layout_columns( + col_widths = c(9, 3), + card( + card_body( + h4('Colors'), + layout_columns( + col_widths = c(3, 3, 3), + colorPickr( + inputId = ns('sel_fill'), + label = 'Fill color:', + selected = '#5cacee', + update = 'save' + ), + colorPickr( + inputId = ns('sel_line'), + label = 'Line color', + selected = '#EE7942', + update = 'save' + ), + btn_task(ns('reset'), 'Reset', icon('rotate'), + style = 'margin-top: 20px !important;') + ), + plotOutput(ns('sample_plot')) + ) ), - plotOutput(ns('sample_plot')) - )), card(card_body( - h4('Size of input files'), - numericInput(ns('input_file_size'), 'Size in MB', 500, min = 0, step = 100), - btn_task(ns('btn_file_size'), 'Apply', icon('check')) - )) - )) + card( + card_body( + h4('Size of input files'), + layout_columns( + col_widths = c(6, 6), + numericInput( + ns('input_file_size'), + 'Size in MB', + 500, + min = 0, + step = 100 + ), + btn_task(ns('btn_file_size'), 'Apply', icon('check'), + style = 'margin-top: 20px !important;') + ) + ) + ) + ) + ) ) } @@ -60,16 +88,14 @@ page_config_server <- function(id) { }) |> bindEvent(input$btn_file_size) observe({ - updateColorPickr( - session = session, - inputId = 'sel_fill', action = 'show', value = '#5cacee') - - updateColorPickr( - session = session, - inputId = 'sel_line', action = 'show', value = '#EE7942') + updateColorPickr(session = session, + inputId = 'sel_fill', + value = '#5cacee') + updateColorPickr(session = session, + inputId = 'sel_line', + value = '#EE7942') - }) |> - bindEvent(input$reset) + }) |> bindEvent(input$reset) return(list(palette = palette)) diff --git a/R/save_gt_module.R b/R/save_gt_module.R new file mode 100644 index 0000000..b5d906d --- /dev/null +++ b/R/save_gt_module.R @@ -0,0 +1,39 @@ + +# ui -------------------------------------------------------------------------- +save_gt_ui <- function(id) { + ns <- NS(id) + + dropdownButton( + inputId = ns('drop_btn'), + label = 'Save', + tagList( + h3('Save table'), + textInput(ns('file_name'), 'File name', value = 'table'), + radioGroupButtons(ns('radio_format'), 'Format', + c('html', 'rtf', 'docx'), size = 'sm', individual = T), + downloadButton(ns('down_handler'), + 'Save table', icon('download')), + br()), + circle = F, size = 'sm', icon = icon('download') + ) +} + +# server ---------------------------------------------------------------------- +save_gt_server <- function(id, input_table) { + moduleServer(id, function(input, output, session) { + + output$down_handler <- downloadHandler( + + filename = function() { + req(input_table()) + paste(input$file_name, + switch(input$radio_format, + html = '.html', rtf = '.rtf', docx = '.docx')) + }, + content = function(file) { + req(input_table()) + gtsave(input_table(), file) + } + ) + }) +} diff --git a/R/spada.R b/R/spada.R index f1ea0a3..16433d5 100644 --- a/R/spada.R +++ b/R/spada.R @@ -14,14 +14,15 @@ #' @importFrom bsicons bs_icon #' @importFrom gt cols_align cols_hide cols_label cols_merge cols_move #' cols_width data_color fmt_bytes fmt_icon fmt_integer -#' fmt_number fmt_percent gt gt_output opt_interactive render_gt -#' sub_missing tab_options +#' fmt_number fmt_percent gt gt_output gtsave opt_interactive +#' render_gt sub_missing tab_options #' #' @importFrom bslib accordion accordion_panel bs_theme card card_body #' card_footer card_header layout_column_wrap layout_columns #' layout_sidebar nav_item nav_menu nav_panel nav_select nav_spacer #' navset_card_pill page_navbar popover sidebar tooltip value_box -#' @importFrom shinyWidgets colorPickr updateColorPickr +#' @importFrom shinyWidgets colorPickr updateColorPickr show_toast dropdownButton +#' radioGroupButtons #' @importFrom dplyr arrange filter mutate pull select #' @importFrom graphics abline hist #' @importFrom utils object.size head @@ -29,6 +30,7 @@ #' @importFrom stats cor lm sd var median rnorm IQR cor.test dnorm ks.test #' qqline qqnorm shapiro.test #' @importFrom grDevices colors +#' @importFrom shinybusy busy_start_up spin_epic spada <- function(...) { datasets <- list(...) diff --git a/R/spada_server.R b/R/spada_server.R index cf46159..ba526af 100644 --- a/R/spada_server.R +++ b/R/spada_server.R @@ -103,7 +103,7 @@ spada_server <- function(datasets){ observe({ if(!is_valid_name(input$pD_data_txt_new_name) || (input$pD_data_txt_new_name %in% dt_names_react())){ - msg_error('Name invalid or already in use') + msg_error('New name is not valid or already in use') } else { dt_react$data[[ input$pD_data_txt_new_name ]] <- df$df_active msg(paste('Dataset', input$pD_data_txt_new_name, 'created')) diff --git a/R/spada_ui.R b/R/spada_ui.R index afb436a..90a86b7 100644 --- a/R/spada_ui.R +++ b/R/spada_ui.R @@ -4,6 +4,21 @@ spada_ui <- function(){ tagList( useBusyIndicators(), + busy_start_up( + loader = spin_epic('orbit', color = '#FFFFFF'), + text = tagList( + h1( + 'Spada', + style = "font-family: 'Times'; font-size: 120px;"), + p('Loading...', + style = "font-family: 'Times'; font-size: 20px;") + ), + mode = 'auto', + timeout = 1200, + color = '#FFFFFF', + background = '#02517d' + ), + # close the app tag_js_exit, diff --git a/R/stats_table_module.R b/R/stats_table_module.R index e58226c..6e06601 100644 --- a/R/stats_table_module.R +++ b/R/stats_table_module.R @@ -5,7 +5,13 @@ stats_table_ui <- function(id) { card( card_body(gt_output(ns('gt_stats'))), card_footer( - numericInput(ns('table_digits'), 'Digits', 2, 0, 9, 1), + layout_columns( + col_widths = c(6, 6), + numericInput(ns('table_digits'), 'Digits', 2, 0, 9, 1), + div(style = "margin-top: 24px !important;", + save_gt_ui(ns('pA_stats_table_save_gt')) + ) + ), div(style = "margin-bottom: -18px !important;") ) ) @@ -27,7 +33,7 @@ stats_table_server <- function(id, var1, var2, input_percentile, percentile, stats_table <- reactive( data.frame( - var = c( + measure = c( paste("% NA's (", stats_n_nas(), '/', stats_obs(), ')'), 'Minimum', 'Percentile 25', @@ -54,26 +60,37 @@ stats_table_server <- function(id, var1, var2, input_percentile, percentile, ) ) + stats_table_fmt <- reactive({ + stats_table() |> + gt() |> + sub_missing() |> + cols_label(measure = 'Measure', value = 'Value') |> + fmt_number(decimals = min(max(0, input$table_digits), 9)) + }) + output$gt_stats <- render_gt({ validate( need( isTruthy(input_percentile()) && between(input_percentile(), 0, 100), - 'Percentile must be between 0 and 100')) + 'Percentile must be between 0 and 100'), + need( + isTruthy(input$table_digits) && + between(input$table_digits, 0, 9), + 'Percentile must be between 0 and 9') + ) - stats_table() |> - gt() |> - sub_missing() |> - cols_label(var = 'Measure', value = 'Value') |> - fmt_number(decimals = input$table_digits) |> + stats_table_fmt() |> opt_interactive(use_pagination = F, use_highlight = T, use_compact_mode = T) |> tab_options(table.background.color = '#ffffff') }) |> bindCache( input$table_digits, - stats_table() + stats_table_fmt() ) + save_gt_server('pA_stats_table_save_gt', stats_table_fmt) + }) } diff --git a/R/utils.R b/R/utils.R index b707a56..6fc577b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -134,12 +134,31 @@ btn_task <- function(ID, LABEL, ICON = NULL, ...){ } # messages - shownotification ------------------------------------------------- -msg <- function(TEXT, DURATION = 2){ - showNotification(ui = TEXT, duration = DURATION, type = 'message') +msg <- function(TEXT, DURATION = 2.3){ + # showNotification(ui = TEXT, duration = DURATION, type = 'message') + + show_toast( + title = TEXT, + type = 'info', + position = 'center', + timer = DURATION * 1000, + timerProgressBar = F, + width = '650px' + ) + } -msg_error <- function(TEXT, DURATION = 2){ - showNotification(ui = TEXT, duration = DURATION, type = 'error') +msg_error <- function(TEXT, DURATION = 2.3){ + # showNotification(ui = TEXT, duration = DURATION, type = 'error') + + show_toast( + title = TEXT, + type = 'error', + position = 'center', + timer = DURATION * 1000, + timerProgressBar = F, + width = '650px' + ) } # try convert ----------------------------------------------------------------- diff --git a/docs/news/index.html b/docs/news/index.html index cb251ed..bdfc012 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -70,9 +70,22 @@

TO DO -

2025.01.17-1

+

2025.01.20-1

Improvements

+

1 - Startup page: now with startup page with shinybusy package (new dependencie)

+

2 - radioGroupButtons: change some radioButtons (shiny) for radioGroupButtons (shinyWidgets) in data_overview_module and exploratory_module for better look

+

3 - Page config module: colorPickr now with ‘save’ mode for better reset of values and other visual changes fo better look

+

4 - New Save gt module: now the gt table can be saved to hmtl, rtf and docx (gt::gt_save function)

+

5 - Stats table module: check for digits if out of range (0, 9) and new save_gt module in this module

+

6 - Descriptive Stats module: insert req to generate stats and new save_gt_module in this module

+

7 - show_toast: change showNotification (shiny) for show_toast (shinyWidgets) for better look

+
+ +
+

2025.01.17-1

+
+

Improvements

1 - New module: Filter Rows

2 - Convert module: always align right the preview table

3 - Descriptive Stats module: now all options inicially as TRUE

@@ -81,12 +94,13 @@

Improvements

2025.01.14-1

-

Improvements

+

Improvements

1 - New module: Normality test

2 - Module Correlation > Scatter Plot now has a button to render plot

3 - Module Descriptive Stats now has a button to render table

@@ -100,7 +114,7 @@

Bug Fixes1 - Edit > Filter: Factor var - no levels after choose operator: fixed (inserted req(operator)). Now the levels are shown when a factor var and an operator are selected. (#9)

-

Improvements

+

Improvements

1 - testthat: create structure to run tests (test-fina.R as initial test)

2 - New modules: Order Rows, Convert Cols and Exploratory

3 - Correlation module: insert req in scatter plot

@@ -115,7 +129,7 @@

Improvements

2025.01.12-1

-

Improvements

+

Improvements

1 - New modules: Sidebar and Navbar Df Info

2 - New function filter_rows in utils.R

3 - New reactives: df_active_ncol, df_active_resume_data and df$df_trigger (to use for updates)

@@ -141,7 +155,7 @@

Bug Fixes1 - Analysis > Exploratory: error ins stats table when percentile out of range 0-100: now test the range and if the input isTruphy (#8)

-

Improvements

+

Improvements

1 - Stats table now is a module

2 - new module Correlation

3 - new module Descriptive Stats

@@ -159,7 +173,7 @@

Bug Fixes4 - Edit > Filter: accept blank value: now the value must have length 1 or bigger (#7)

-

Improvements

+

Improvements

1 - utils functions

2 - page_config_module: correction of a typo

3 - spada function

@@ -175,7 +189,7 @@

Bug Fixes1 - Data Overview - after Edit only refresh if updat in rows or sample: fixed with insertion of buttons inside output$pD_over_gt. (#3)

-

Improvements

+

Improvements

1 - export_file_module: separator order now semicolon as default

2 - new import_file_module: allows input csv and RDS files

3 - page_config_module: new visual and size of input file as parameter

@@ -199,7 +213,7 @@

Bug Fixes2 - Metadata - Error in zeros count: now df_info function uses suna(x == 0) instead of length(x[x == 0]) (#2)

-

Improvements

+

Improvements

1 - utils functions