R/convert_cols_module.R

In spada: A 'shiny' Package for Data Analysis

# ui --------------------------------------------------------------------------
convert_cols_ui <- function(id) {
  ns <- NS(id)

  layout_column_wrap(
    card(
      card_header('Conversions', class = 'mini-header'),
      card_body(
        layout_column_wrap(
          height = '200px',
          selectInput(ns('vars_sel'), 'Variable', ''),
          textInput(ns('txt_current_format'), 'Current Type / Class')
        ),
        layout_column_wrap(
          height = '800px',
          selectInput(ns('sel_format'), 'Select the new format',
                      c('', 'as.numeric', 'as.integer',
                        'as.character', 'as.Date', 'as.factor',
                        'as.double')),
          conditionalPanel(
            condition = sprintf("input['%s'] == 'as.Date'", ns('sel_format')),
            selectInput(
              ns('sel_date_formats'),
              list('Select the entry format', bs_icon('info-circle')) |>
                tooltip('For character and factor inputs'),
              date_formats),
            dateInput(ns('sel_date_origin'),
                      list('Select a start date', bs_icon('info-circle')) |>
                        tooltip('For numeric inputs'),
                      value = '1970-01-01')
          )
        )
      ),
      card_footer(btn_task(ns('btn_apply'), 'Apply conversion', icon('check')))
    ),
    card(
      card_header('Preview', class = 'mini-header'),
      card_body(gt_output(ns('preview_gt'))),
      card_footer(btn_task(ns('btn_preview_sample'),
                           'Show new sample', icon('rotate-right')))
    )
  )
}

# server ----------------------------------------------------------------------
convert_cols_server <- function(id) {
  moduleServer(id, function(input, output, session) {
	  ns <- session$ns

    df_names <- reactive(get_act_dt(session) |> names())

    # update select vars input ---------------
    observe({
      req(df_names())
      updateSelectInput(
        session,
        'vars_sel',
        choices = c('', df_names())
      )
    }) |> bindEvent(df_names())

    # update current format txt --------------
    observe({
      if(!isTruthy(input$vars_sel)){
        format <- ''
      } else {
        format <- paste(
          'Type: [', get_act_dt(session)[[input$vars_sel]] |> typeof(),
          '] | Class: [',
          paste(get_act_dt(session)[[input$vars_sel]] |> class(), collapse = '/'),
          ']'
        )
      }
      updateTextInput(session, 'txt_current_format', value = format)
    }) |> bindEvent(input$vars_sel)

    # sample to preview conversion -----------
    preview_sample_trigger <- reactiveVal(1)
    preview_sample <- reactive({
      nrow_act_dt <- get_act_dt(session) |> nrow()

      if(nrow_act_dt < 8) {
        rep(TRUE, nrow_act_dt)
      } else {
        sample(nrow_act_dt, 8, replace = F)
      }
    }) |> bindEvent(preview_sample_trigger(), session$userData$dt$act_meta())

    # update sample in button click ----------
    observe({
      preview_sample_trigger(preview_sample_trigger() + 1)
    }) |> bindEvent(input$btn_preview_sample)

    preview_df <- reactive({
      req(input$vars_sel)
      req(input$sel_format)

      if(input$sel_format == 'as.Date'){
        req(input$sel_date_formats)
      }

      preview_df_temp <- subset(
        get_act_dt(session)[preview_sample(), ], select = input$vars_sel)

      preview_df_temp[
        , preview := convert(var1,
                             type = input$sel_format,
                             date_format = input$sel_date_formats,
                             date_origin = input$sel_date_origin),
        env = list(var1 = input$vars_sel)]
    })

    # render preview gt ----------------------
    output$preview_gt <- render_gt({
      req(input$vars_sel, input$sel_format, preview_df())
      if(input$vars_sel %in% df_names()){
        preview_df() |>
          lapply(\(x) if(is.complex(x)) as.character(x) else x) |>
          as.data.frame() |>
          gt() |>
          cols_align(align = 'right') |>
          opt_interactive(
            use_sorting = F,
            use_pagination = F,
            use_highlight = T,
            use_compact_mode = T) |>
          tab_options(table.background.color = bg_color)
      }
    })

    # apply conversions -------------------------------------------------------
    observe({
      if(!isTruthy(input$vars_sel) || !isTruthy(input$sel_format)){
        msg('Select a variable and a new format')
        return()
      } else {
        running_modal()
        temp <- copy(get_act_dt(session))

        temp[, input$vars_sel :=
                       convert(var1,
                               type = input$sel_format,
                               date_format = input$sel_date_formats,
                               date_origin = input$sel_date_origin),
                     env = list(var1 = input$vars_sel)]

        update_act_dt(session, copy(temp), updated_cols = input$vars_sel,
                      change_type = 'convert_cols')
        rm(temp)
        remove_running_modal()

        updateSelectInput(session, 'vars_sel', selected = character(0))
        updateSelectInput(session, 'sel_format', selected = character(0))
      }
    }) |> bindEvent(input$btn_apply)
  })
}