r - 将 UpdateTabsetPanel 与动态 UI 一起使用

Question

我正在尝试创建一个应用程序，该应用程序允许用户在线性回归模型中动态转换变量，以了解这样做对回归诊断（残差图等）的影响。

在下面的应用程序中，您将看到用户可以选择对目标变量进行日志转换，并且在这样做时，会显示三种类型的日志转换来执行。这适用于单个变量，但我试图提供使用预测变量的能力。这变得特别复杂，因为预测变量的数量不是固定的，而是基于用户的选择。

我认识到这里的一个问题是我需要为每个预测器创建一个单独的 tabsetPanel。为此，我创建了一个函数来创建 tabsetPanel，它允许用户指定 ID。应用程序的这个组件工作正常，但是当需要尝试渲染动态参数选择时，应用程序不起作用。有谁知道如何解决这个问题？如果下面的可重现示例有点长，我们深表歉意 - 无法找到一种在不丢失一般问题范围的情况下简化的方法。

## libraries
library(tidyverse)
library(shiny)

## stored data objects, including variable and transformation names
dat <- mtcars
var_names <- dat %>% select(1:3) %>% colnames %>% sort
tran_names <- c("None", "Logarithmic")

## create conditional UI for transformation parameters
param_select <- function(object_name) {
  tabsetPanel(
    id = object_name,
    type = "hidden",
    tabPanel("None",
             fluidRow()),
    tabPanel("Logarithmic",
             fluidRow(column(width = 3, 
                             selectInput(inputId = "log_param",
                                         label = "Type:",
                                         choices = c("Natural", "Base 2", "Base 10"))))))
}

## create base UI
ui <- fluidPage(
  fluidRow(column(width = 2, 
                  ## input selector for target variable
                  selectInput(inputId = "target", 
                              label = "Target Variable", 
                              choices = var_names)),
           column(width = 2, 
                  ## input selector for target variable transformation, excluding polynomials
                  selectInput(inputId = "target_trans", 
                              label = "Select Transformation", 
                              choices = tran_names %>% .[.!="Polynomial"])),
           column(width = 8, param_select("params"))),
  ## input selector for number of predictors
  numericInput(inputId = "preds_n", 
               label = "Select Number of Predictors", 
               value = 1, 
               min = 1,
               max = length(var_names) - 1,
               width = "190px"),
  ## stored layout for dynamic UI
  fluidRow(column(width = 2, uiOutput("preds_ui")),
           column(width = 2, uiOutput("pred_trans_ui")),
           column(width = 8, uiOutput("pred_param_ui")))
)

server <- function(input, output, session) {
  ## parameter selections for target variable
  observeEvent(input$target_trans, {
    updateTabsetPanel(session = session, inputId = "params", selected = input$target_trans)
  }) 
  ## create objects to store individual predictors
  preds <- reactive(paste0("Predictor ", seq_len(input$preds_n)))
  output$preds_ui <- renderUI({
    preds() %>% map(~ selectInput(inputId = .x, 
                                  label = .x, 
                                  choices = var_names,
                                  selected = isolate(input[[.x]])) %||% "")
  })
  ## create objects to store individual predictors transformations
  pred_trans <- reactive(paste0("Transformation ", seq_len(input$preds_n)))
  output$pred_trans_ui <- renderUI({
    pred_trans() %>% map(~ selectInput(inputId = .x, 
                                       label = .x, 
                                       choices = tran_names,
                                       selected = isolate(input[[.x]])) %||% "")
  })
  ## create objects to store individual predictors transformations parameters
  ## this is where i'm stuck :(
  pred_params <- reactive(paste0("Parameter ", seq_len(input$preds_n)))
  pred_param_select <- reactive(pred_params() %>% 
                                  map(~param_select(object_name = .x) %>% 
                                        setNames(nm = .x)))
  output$pred_param_ui <- renderUI({
    pred_params() %>% 
      map(~observeEvent(input[[.x]], {
        updateTabsetPanel(session = session, inputId = "params", selected = input[[.x]])
      }))
  })
}

shinyApp(ui, server)

请注意，这个问题是我之前的问题的扩展。

标签： rshiny