how to evaluate textInput inside a Shiny Module as arguments

40 Views Asked by At

I am working on a Shiny app that serves as an interface for the gtsummary package.

One of the features I've added is the ability to apply functions like add_p() to the generated tables, and it's working as expected. However, I encountered a roadblock when attempting to provide users with the option to add custom arguments.

For instance, while my_table %>% add_p() works ok, I wanted to allow users to input custom arguments. Unfortunately, it seems that implementing this with eval, rlang, etc is proving to be challenging. If I set custom_arguments to something like " %>% add_p()", I can't find a way to make it evaluate.

I've running out of ideas. Can someone provide guidance on how to allow users to input custom arguments that are evaluated correctly in the context of the gtsummary package within a Shiny app? Here a simplified working example (with the pseudocode commented)

library(shiny)
library(shinyWidgets)
library(gtsummary)
library(gt)

# Sample data
set.seed(123)

control_group <- data.frame(
  Patient_ID = 1:50,
  Group = "Control",
  Weight_loss = rnorm(50, mean = 0, sd = 2)
)


treatment_group <- data.frame(
  Patient_ID = 51:100,
  Group = "Treatment",
  Weight_loss = rnorm(50, mean = 3, sd = 2)
)

weight_loss_data <- rbind(control_group, treatment_group)

# UI module
gtsum_ui <- function(id) {
  ns <- NS(id)

  tagList(
    checkboxInput(
      inputId = ns("add_p_values"),
      label = "Add p-values",
      value = FALSE
    ),

    checkboxInput(
      inputId = ns("checkArguments"),
      label = "Custom Argument",
      value = FALSE
    ),

    textInput(
    inputId = ns("customArguments"),
    label = "Custom Argument Text",
    placeholder = "Type custom argument here"

    ),

    column(
      width = 9,
      tags$h3("Summary Table"),
      div(
        class = "custom-button",
        actionButton(
          inputId = ns("generate_table"),
          label = "Calculate",
          class = "btn btn-primary",
          style = "width: 100%;"
        ),
        gt_output(outputId = ns("my_gt_table"))
      )
    )
  )
}

# Module Server
gtsum_server <- function(id, data) {
  moduleServer(
    id,
    function(input, output, session) {


      observeEvent(input$generate_table, {

        my_table <-  data() %>%
          tbl_summary(by=Group)

        if (input$add_p_values) {
         my_table <- my_table %>% add_p()
        }

        if (input$checkArguments) {
          custom_argument <- input$customArguments

          #in this case I write add_p() I've tried eval, tlang, tidyselect etc
          # pseudocode
          # mytable = mytable %>% custom_argument
          print("custom")
          mytable = mytable %>% custom_argument
        }

        gt_my_table <- my_table %>% as_gt()

        output$my_gt_table <- render_gt({
          gt_my_table
        })

      })
    }
  )
}

#minimal app for module
# UI
ui <- fluidPage(
  gtsum_ui("module")
)

# server
server <- function(input, output, session) {
  data <- reactiveVal(weight_loss_data)
  gtsum_server("module", data)
}

# Run 
shinyApp(ui, server)
1

There are 1 best solutions below

0
Jojostack On

Thanks to the suggestion from Stèfane now everything works. Suggestion for increasing the security are wellcome

if (input$checkArguments) {
            custom_argument <- input$customArguments
            custom_expression <- paste("my_table", custom_argument)

            print("custom")
            my_table <- eval(parse(text = custom_expression))
            print(my_table)
          }
          
          
          
library(shiny)
library(shinyWidgets)
library(gtsummary)
library(gt)

# Sample data
set.seed(123)

control_group <- data.frame(
  Patient_ID = 1:50,
  Group = "Control",
  Weight_loss = rnorm(50, mean = 0, sd = 2)
)


treatment_group <- data.frame(
  Patient_ID = 51:100,
  Group = "Treatment",
  Weight_loss = rnorm(50, mean = 3, sd = 2)
)

weight_loss_data <- rbind(control_group, treatment_group)

# UI module
gtsum_ui <- function(id) {
  ns <- NS(id)

  tagList(
    checkboxInput(
      inputId = ns("add_p_values"),
      label = "Add p-values",
      value = FALSE
    ),

    checkboxInput(
      inputId = ns("checkArguments"),
      label = "Custom Argument",
      value = FALSE
    ),

    textInput(
    inputId = ns("customArguments"),
    label = "Custom Argument Text",
    placeholder = "Type custom argument here"

    ),

    column(
      width = 9,
      tags$h3("Summary Table"),
      div(
        class = "custom-button",
        actionButton(
          inputId = ns("generate_table"),
          label = "Calculate",
          class = "btn btn-primary",
          style = "width: 100%;"
        ),
        gt_output(outputId = ns("my_gt_table"))
      )
    )
  )
}

# Module Server
gtsum_server <- function(id, data) {
  moduleServer(
    id,
    function(input, output, session) {


      observeEvent(input$generate_table, {

        my_table <-  data() %>%
          tbl_summary(by=Group)

        if (input$add_p_values) {
         my_table <- my_table %>% add_p()
        }

        if (input$checkArguments) {
         custom_argument <- input$customArguments
         custom_expression <- paste("my_table", custom_argument)

         print("custom")
         my_table <- eval(parse(text = custom_expression))
         print(my_table)
          }

        gt_my_table <- my_table %>% as_gt()

        output$my_gt_table <- render_gt({
          gt_my_table
        })

      })
    }
  )
}

#minimal app for module
# UI
ui <- fluidPage(
  gtsum_ui("module")
)

# server
server <- function(input, output, session) {
  data <- reactiveVal(weight_loss_data)
  gtsum_server("module", data)
}

# Run 
shinyApp(ui, server)