Question

我正在寻找一种方法，使三个单独的valueBox响应相同的selectInput。我的数据框：

[assembly: ControlDefinition("*", ComponentTypeName = "text input", TargetType = typeof(TextInput<>))]

对于selectInput，我需要腹泻，发烧和ARI作为选项，我希望看到三个值框，一个用于阿富汗，一个用于男孩，一个用于女孩，其值与输入变量相对应。我似乎不知道该怎么办。。

谢谢！

region        Diarrhea       Fever     ARI
Afghanistan   78.2          56.4       29.7
Boys          34.1          23.2       15.6
Girls         18.4          12.8       11.2

Answer 1

您可以单独创建uiOutputs，但是更简洁的方法是在lapply内使用renderUI来循环生成的dataframe。请注意，我将您的输入重命名为selected_column，并修改了输入中的选项。

下面给出一个可行的示例，希望对您有所帮助！

overall = read.table(text = 'region        Diarrhea       Fever     ARI
Afghanistan   78.2          56.4       29.7
Boys          34.1          23.2       15.6
Girls         18.4          12.8       11.2', header=T)

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    box(title = "Data", status = "primary", solidHeader = T, width = 12,
        fluidPage(
          fluidRow(
            column(2, offset = 0, style = 'padding:1px;', 
                   selectInput(inputId = "selected_column",
                               label = "Indicator",
                               choices = setdiff(colnames(overall),'region')))
          )
        )
    ),
    uiOutput("value_box")
  )
)

server <- function(input, output) {
  output$value_box <- renderUI({
    box(width=12,
    lapply(1:nrow(overall), function(i) {
      valueBox(overall[i,input$selected_column],overall[i,'region'])})
    )
  })
}

shinyApp(ui = ui, server = server)

编辑：根据您的评论中的要求，这将是一个如何使用单独的UI元素进行此工作的示例：

overall = read.table(text = 'region        Diarrhea       Fever     ARI
Afghanistan   78.2          56.4       29.7
                     Boys          34.1          23.2       15.6
                     Girls         18.4          12.8       11.2', header=T)

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    box(title = "Data", status = "primary", solidHeader = T, width = 12,
        fluidPage(
          fluidRow(
            column(2, offset = 0, style = 'padding:1px;', 
                   selectInput(inputId = "selected_column",
                               label = "Indicator",
                               choices = setdiff(colnames(overall),'region')))
          )
        )
    ),
    box(width=12,
        uiOutput("value_box1"),
        uiOutput("value_box2")
    )
  )
)

server <- function(input, output) {

  output$value_box1 <- renderUI({
    valueBox(overall[1,input$selected_column],overall[1,'region'])
  })

  output$value_box2 <- renderUI({
    valueBox(overall[2,input$selected_column],overall[2,'region'])
  })

}

shinyApp(ui = ui, server = server)

用于多个valueBox的SelectInput

1 个答案: