Question

我有以下代码动态制作复选框或滑块。

 server <- shinyServer(function(input, output, session) {
  # define the data frame to use
  dat <- mtcars
  dat <- rownames_to_column(dat, "car")
  # name of availale data frame
  varNames <-  names(dat)
  # define defaul values as the first value in each column
  defaultValues <- as.numeric(dat[1,])
  # store the selected variable in a reactive variable 


  # dynamically creates a set of sliders
  output$controls <- renderUI({
    div(
      fluidRow(
        column(9, uiOutput("rangeUI"))
      )
    )
  })

output$rangeUI <- renderUI({
 lapply(1:length(varNames), function(k) {
   fluidRow(
     column(12,
           if (is_character(dat[1, k])) {
             # a slider range will created only is the variable is selected


             checkboxGroupInput(paste0("slider_", varNames[k]), label = varNames[k], choices = unique(dat[[k]]), selected = NULL,
                                inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
           } else {
             # otherwise uses single value with a default value
             sliderInput(paste0("slider_", varNames[k]), label = varNames[k], 
                         min = 0, max = 100, value = defaultValues[k])
           }
    )
  )
 })
})

我遇到的问题是我想并排显示滑块和复选框，直到它们达到屏幕宽度然后开始新行。目前，它们都在一列中。

是否有一种动态调整offset来实现此目的的好方法，可能是这样的？

column(12, offset = match(k, colnames(dat)), # then lead into the if else statement

欢迎任何有关构建用户界面的其他建议。

Answer 1

尝试将fluidRow放在lapply之外，并将列的大小从12更改为3，否则您只需要一列创建多行而是在有多列的一行上。

以下是您的代码修改，也许它可以帮助您。

library(shiny)
library(tibble)
ui <- fluidPage(
  uiOutput("controls")
)

server <- shinyServer(function(input, output, session) {
  # define the data frame to use
  dat <- mtcars
  dat <- rownames_to_column(dat, "car")
  # name of availale data frame
  varNames <-  names(dat)
  # define defaul values as the first value in each column
  defaultValues <- as.numeric(dat[1,])
  # store the selected variable in a reactive variable 

  # dynamically creates a set of sliders
  output$controls <- renderUI({
    fluidRow(
      column(offset = 3, 9, uiOutput("rangeUI"))
    )
  })
  # to test that a dynamically created input works with an observer
  observeEvent(input$slider_mpg, {
    cat("slider_mpg:", input$slider_mpg, "\n")
  })
  output$rangeUI <- renderUI({
    fluidRow(
      lapply(1:length(varNames), function(k) {
        column(3,
          if (is.character(dat[1, k])) {
            # a slider range will created only is the variable is selected
            checkboxGroupInput(paste0("slider_", varNames[k]), label = varNames[k], choices = unique(dat[[k]]), selected = NULL,
                              inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
          } else {
            # otherwise uses single value with a default value
            sliderInput(paste0("slider_", varNames[k]), label = varNames[k], 
                       min = 0, max = 100, value = defaultValues[k])
          }
        )
      })
    )
  })
})

shinyApp(ui = ui, server = server)

<强>更新

您可以使用操作按钮获取动态创建的输入值，如here所述，或使用解释为here的解决方案自动获取。

在Shiny中动态更新sliderInput的位置

1 个答案: