如何将 Shiny 模块内的 textInput 作为参数进行计算

Question

我正在开发一个 Shiny 应用程序，用作 gtsummary 包的界面。

我添加的功能之一是能够将 add_p() 等函数应用于生成的表，并且它按预期工作。 但是，在尝试向用户提供添加自定义参数的选项时，我遇到了障碍。

例如，虽然 my_table %>% add_p() 工作正常，但我想允许用户输入自定义参数。不幸的是，似乎用 eval、rlang 等来实现这一点被证明是具有挑战性的。如果我将 custom_arguments 设置为“ %>% add_p()”之类的内容，我找不到对其进行评估的方法。

我已经没有主意了。有人可以提供有关如何允许用户输入在 Shiny 应用程序中的 gtsummary 包上下文中正确评估的自定义参数的指导吗？ 这是一个简化的工作示例（带有注释的伪代码）

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)

Answer 1

感谢 Stèfane 的建议，现在一切正常。欢迎提出提高安全性的建议

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)