用于多个valueBox的SelectInput

Question

I am looking for a way to have three separate valueBoxes respond to the same selectInput. My dataframe:

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

For selectInput I want Diarrhe, Fever and ARI as options, and I would like to see three Value boxes, one for Afghanistan, one for Boys and one for Girls with the value corresponding to input variable. I cant seem to figure out how to this..

Thanks!

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_data",
                               label = "Indicator",
                               choices = overall[,c(2:4)]))
          )
        )
    ),
    uiOutput("value_box")
  )
)

server <- function(input, output) {
  output$value_box <- renderUI({
    valueBox(input$selected_data,subtitle = "Afghanistan")

  })
}


shinyApp(ui = ui, server = server)

Answer 1

You could make separate uiOutputs , but a more concise approach would be to use lapply inside the renderUI to loop over your resulting dataframe . Note that I renamed your input to selected_column and I modified the options in the input.

A working example is given below, hope this helps!

---

---

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)

---

EDIT: As requested in your comment, this would be an example on how to make this work with separate UI elements:

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)