1

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)
Cœur
  • 37,241
  • 25
  • 195
  • 267
Margo
  • 13
  • 3
  • Hi Margo, welcome to Stack Overflow! This is a very good first question on SO with a good small example to make it clear what you are looking for. There are some small improvements you could make to future questions to get your questions potentially answered even quicker, such as including the libraries and the data needed to reconstruct your problem, see [here](https://stackoverflow.com/questions/48343080/how-to-convert-a-shiny-app-consisting-of-multiple-files-into-an-easily-shareable/48343110#48343110) for some tips. Anyway, just small things :) – Florian Nov 22 '18 at 16:26

1 Answers1

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!


enter image description here


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)
Florian
  • 24,425
  • 4
  • 49
  • 80
  • Hi Florian, thanks for the suggestions on improving my question, and of course for the solution to my problem! Works like a charm! Thanks! – Margo Nov 26 '18 at 08:00
  • Great, glad I could help :) Please consider [accepting the answer](https://meta.stackexchange.com/a/5235/364979) to mark your question as resolved. – Florian Nov 26 '18 at 08:14
  • Certainly! If I am not asking too much of your time and wisdom - what would it look like if I were to use multiple uiOutputs responding to the same SelectInput, rather than looping through? – Margo Nov 26 '18 at 11:11
  • You're a hero! Thanks so much Florian – Margo Nov 27 '18 at 11:28