How to modularize a reactive function in Shiny R

Question

I gotta admit I'm stumped on this one. I have a function that takes a data frame and returns summary data from user specific variables inside it. It looks like this:

   descr_function <- function(data, ...){
      stats <- data %>% 
        group_by(variable, ...) %>%
        summarize(N = length(value[!is.na(value)]),
                  Missing = length(value[is.na(value)]),
                  Perc.Avail = (length(value[!is.na(value)])/(length(value[!is.na(value)]) + length(value[is.na(value)]))) * 100,
                  Mean = mean(value, na.rm=TRUE),
                  Median = median(value, na.rm=TRUE),
                  Min = min(value, na.rm=TRUE),
                  Max = max(value, na.rm=TRUE),
                  Range = max(value, na.rm=TRUE) - min(value, na.rm=TRUE),
                  Variance = var(value, na.rm=TRUE),
                  Std.Dev = sd(value, na.rm=TRUE),
                  Coef.Var = sd(value, na.rm=TRUE)/mean(value, na.rm=TRUE),
                  SE = sd(value, na.rm=TRUE)/sqrt(length(value[!is.na(value)])),
                  Skewness = e1071::skewness(value, na.rm=TRUE),
                  Kurtosis = e1071::kurtosis(value, na.rm=TRUE),
                  IQR = IQR(value, na.rm=TRUE),
                  MAD = mad(value, na.rm=TRUE)
        )
      stats <- data.frame(stats)
      stats[,4:17] <- round2(stats[,4:17],input$descrDigits)
      return(stats)}

The function is called by:

 all_stats <- descr_function(descrDataMelted)

The UI is called by:

numericInput('descrDigits','# Decimals to Display', value = 3, min = 0, max = 10, step = 1), 

I want the function to react to input$descrDigits. Starting from the basics on the R Studio website gives me something like this:

statsNumericInput <- function(id, label = "Counter") {
  ns <- NS(id)
  numericInput(ns('descrDigits'), label)
}

numericInputServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      # PUT descr_function in here??
    }
  )
}

In UI part of Shiny app call:

statsNumericInput("descrDigits", label = '# Decimals to Display', value = 3, min = 0, max = 10, step = 1)

In server part of code call:

numericInputServer("descrDigits", variables I want to get stats for?)

I know this question is pretty open ended, but I could use some guidance as to how to adjust my code to get this to work. Any help would be wonderful. Thank you.

Answer 1

My take on it (but not tested):

library(dplyr)
library(shiny)
library(DT)

descr_function <- function(data, digits, ...){
  stats <- data %>% 
    group_by(variable, ...) %>%
    summarize(N = length(value[!is.na(value)]),
              Missing = length(value[is.na(value)]),
              Perc.Avail = (length(value[!is.na(value)])/(length(value[!is.na(value)]) + length(value[is.na(value)]))) * 100,
              Mean = mean(value, na.rm=TRUE),
              Median = median(value, na.rm=TRUE),
              Min = min(value, na.rm=TRUE),
              Max = max(value, na.rm=TRUE),
              Range = max(value, na.rm=TRUE) - min(value, na.rm=TRUE),
              Variance = var(value, na.rm=TRUE),
              Std.Dev = sd(value, na.rm=TRUE),
              Coef.Var = sd(value, na.rm=TRUE)/mean(value, na.rm=TRUE),
              SE = sd(value, na.rm=TRUE)/sqrt(length(value[!is.na(value)])),
              Skewness = e1071::skewness(value, na.rm=TRUE),
              Kurtosis = e1071::kurtosis(value, na.rm=TRUE),
              IQR = IQR(value, na.rm=TRUE),
              MAD = mad(value, na.rm=TRUE)
    )
  stats <- data.frame(stats)
  stats[,4:17] <- round2(stats[,4:17], digits)
  return(stats)}

# define the module
statsnumericInputUI <- function(id, label, value, min, max, step) {
  ns <- NS(id)
  numericInput(ns('descrDigits'),
               label = label,
               value = value,
               min = min,
               max = max,
               step = step),
  DTOutput(ns("result_table"))
}

statsnumericInputServer <- function(id, ...) {
  moduleServer(
    id,
    function(input, output, session) {
      all_stats <- reactive({
        descr_function(descrDataMelted, input$descrDigits, ...)
      })
      
      output$result_table <- renderDT({
        datatable(all_stats())
      })
    }
  )
}

# the shiny app
ui <- fluidPage(
  statsnumericInputUI("descrDigits", label = '# Decimals to Display', value = 3, min = 0, max = 10, step = 1)
)

server <- function(input, output, session) {
  statsnumericInputServer("descrDigits") # here you could add variables you want grouping for
}

shinyApp(ui, server)