使用 renderUI 更新数据集而不是条件面板

Question

我正在编写一个闪亮的应用程序来实现以下效果：

每当我选择 categoryname 包含的变量时，网络将生成提供分隔符的滑块。它将选定的变量分成2组，并形成一个新列，其中包含添加到原始数据集中的组名。

这里的人帮助我解决了 this question 中使用条件面板的问题，但现在我结合使用 renderUI 和 shinyjs，因为条件面板在我的大型项目中不起作用。

我被一个小错误卡住了（似乎）：

Error in data.frame: arguments imply differing number of rows: 32, 0

以下是我的代码，如何修改才能使功能生效？

library(shiny)
library(shinyjs)
library(stringr)

categoryname = c("mpg_group", "disp_group")
MT_EG = mtcars[,1:5]

# Define UI for application that draws a histogram
ui <- fluidPage(

  useShinyjs(),

  # Application title
  titlePanel("Mtcars Data"),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "arm",
                  label = "ARM VARIABLE",
                  choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
                  selected = "cyl"),
      # conditionalPanel(
      #   #condition = "categoryname.includes(input.arm)",
      #   condition = "input.arm == 'disp_group' | input.arm == 'mpg_group'",
      #   
      #   #sliderInput("divider", "divide slider", 1, 100, 20)
      #   optionalSliderInputValMinMax("divider", "divide slider", c(50,0,100), ticks = FALSE)
      # )
      uiOutput("divider")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      uiOutput("data")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  output$divider <- renderUI({
    if (input$arm %in% categoryname){
      show("divider")
    }
    else{
      hide("divider")
    }
    sliderInput("divider", "divide slider", 0, 100, 50)
  })

  observeEvent(
    input$arm,
    observe(
      {
        if (input$arm %in% categoryname){
          #browser()
          # start over and remove the former column if exists
          MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

          id_arm_var <- input$arm
          id_arm <- unlist(str_split(id_arm_var,'_'))[1]


          # change the range of the slider
          val <- input$divider
          mx = max(MT_EG[[id_arm]])
          mn = min(MT_EG[[id_arm]])
          updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = input$divider)

          # generate a new column and bind
          divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
          divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
          divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
          colnames(divi) <- id_arm_var
          MT_EG <- cbind(MT_EG,divi)
        }

        output$data=renderTable(MT_EG)
      }
    )
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

我只是使用 mtcars 数据集，以便大家可以访问

Answer 1

observeEvent 和 renderUI 都依赖于 "or triggered by" input$arm。发生的事情是 observeEvent 在 renderUI 之前请求 input$divider 可能在 UI 中呈现并且 input$divider 可用于 observeEvent，正如我上面提到的 input$divider 以 NULL 值结束。

要解决此问题，只需在 MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)] 之前添加 req(input$divider)。还要将 output$divider 更改为 output$dividerUI，因为 Shiny 不允许输入和输出具有相同的 id。

有关详细信息，请参阅 ?shiny::req。

使用 renderUI 更新数据集而不是条件面板

using renderUI to update a data set instead of conditional panel

r

shiny

shinyjs