Display the selectInput value in a R shiny widget box

Question

Please run the R shiny script below, I wish to display the selectInput value in the third selectInput option in the infoBox widget and replicate the same functionality for all the tabs below. Currently it is hard coded, the script has been written using shiny modules, so kindly check. Attaching the snapshot for reference, please help.

candyData <- read.table(
text = "
Brand       Candy           value
Nestle      100Grand        Choc1
Netle       Butterfinger    Choc2
Nestle      Crunch          Choc2
Hershey's   KitKat          Choc4
Hershey's   Reeses          Choc3
Hershey's   Mounds          Choc2
Mars        Snickers        Choc5
Nestle      100Grand        Choc3
Nestle      Crunch          Choc4
Hershey's   KitKat          Choc5
Hershey's   Reeses          Choc2
Hershey's   Mounds          Choc1
Mars        Twix            Choc3
Mars        Vaid            Choc2",
header = TRUE,
stringsAsFactors = FALSE)
library(shiny)
library(shinydashboard)
submenuUI <- function(id) {
ns <- NS(id)
tagList(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
    fluidPage(
      fluidRow(

        column(2,offset = 0, style='padding:1px;',

selectInput(ns("Select1"),"select1",unique(candyData$Brand))),
        column(2,offset = 0,

style='padding:1px;',selectInput(ns("Select2"),"select2",choices = NULL)),
        column(2, offset = 0,

style='padding:1px;',selectInput(ns("Select3"),"select3",choices=NULL ))
      ))
    ),
infoBox("value1", 5)
)}
# submenu <- function(input,output,session){}
submenuServ <- function(input, output, session){
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',


choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
})
observeEvent(input$Select2,{
updateSelectInput(session,'Select3',


choices=unique(candyData$value[candyData$Brand==input$Select1 &

candyData$Candy==input$Select2]))
})}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
  shinyjs::useShinyjs(),
  id = "tabs",
  menuItem("Charts", icon = icon("bar-chart-o"),
           shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
           menuSubItem("Sub-item 1", tabName = "subitem1"),
           menuSubItem("Sub-item 2", tabName = "subitem2"),
           menuSubItem("Sub-item 3", tabName = "subitem3")
  ))),
  dashboardBody(
  tabItems(tabItem("dummy"),
         tabItem("subitem1", submenuUI('submenu1')),
         tabItem("subitem2", submenuUI('submenu2')),
         tabItem("subitem3", submenuUI('submenu3')))))
 server <- function(input, output,session) {

 callModule(submenuServ,"submenu1")
 callModule(submenuServ,"submenu2")
 callModule(submenuServ,"submenu3")
 }
 shinyApp(ui = ui, server = server)

score 2 · Accepted Answer · answered Jan 29 '18 at 10:09

You could do this using infoBoxOutput and renderInfoBox as shown below:

candyData <- read.table(
  text = "
  Brand       Candy           value
  Nestle      100Grand        Choc1
  Netle       Butterfinger    Choc2
  Nestle      Crunch          Choc2
  Hershey's   KitKat          Choc4
  Hershey's   Reeses          Choc3
  Hershey's   Mounds          Choc2
  Mars        Snickers        Choc5
  Nestle      100Grand        Choc3
  Nestle      Crunch          Choc4
  Hershey's   KitKat          Choc5
  Hershey's   Reeses          Choc2
  Hershey's   Mounds          Choc1
  Mars        Twix            Choc3
  Mars        Vaid            Choc2",
  header = TRUE,
  stringsAsFactors = FALSE)
library(shiny)
library(shinydashboard)
submenuUI <- function(id) {
  ns <- NS(id)
  tagList(
    box(title = "Data", status = "primary", solidHeader = T, width = 12,
        fluidPage(
          fluidRow(

            column(2,offset = 0, style='padding:1px;',

                   selectInput(ns("Select1"),"select1",unique(candyData$Brand))),
            column(2,offset = 0,

                   style='padding:1px;',selectInput(ns("Select2"),"select2",choices = NULL)),
            column(2, offset = 0,

                   style='padding:1px;',selectInput(ns("Select3"),"select3",choices=NULL ))
          ))
    ),
    infoBoxOutput(ns("ibox"))
  )}
# submenu <- function(input,output,session){}
submenuServ <- function(input, output, session){
  observeEvent(input$Select1,{
    updateSelectInput(session,'Select2',


                      choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
  })
  observeEvent(input$Select2,{
    updateSelectInput(session,'Select3',


                      choices=unique(candyData$value[candyData$Brand==input$Select1 &

                                                       candyData$Candy==input$Select2]))


    output$ibox <- renderInfoBox({
      infoBox(
        "value1",
        input$Select3
      )
    })


  })}
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      shinyjs::useShinyjs(),
      id = "tabs",
      menuItem("Charts", icon = icon("bar-chart-o"),
               shinyjs::hidden(menuSubItem("dummy", tabName = "dummy")),
               menuSubItem("Sub-item 1", tabName = "subitem1"),
               menuSubItem("Sub-item 2", tabName = "subitem2"),
               menuSubItem("Sub-item 3", tabName = "subitem3")
      ))),
  dashboardBody(
    tabItems(tabItem("dummy"),
             tabItem("subitem1", submenuUI('submenu1')),
             tabItem("subitem2", submenuUI('submenu2')),
             tabItem("subitem3", submenuUI('submenu3')))))
server <- function(input, output,session) {

  callModule(submenuServ,"submenu1")
  callModule(submenuServ,"submenu2")
  callModule(submenuServ,"submenu3")
}
shinyApp(ui = ui, server = server)

Hope it helps!

perfect, thanks a lot, just one small help, in the third selectInput, when I do selection in the second selectInput, a default value is rendered, can you help me put a default message there like select the input rather than displaying a value straight away? — Adam Shaw, Jan 29 '18 at 10:15
What do you mean by message? When you give the choices by default the initial choice will be selected. — SBista, Jan 29 '18 at 10:18
so yes, is there a way to display a default message like "Select the choice" rather than showing the initial value, the user can then click on the dropdown and select the value, please help. — Adam Shaw, Jan 29 '18 at 10:20
You could have that as a choice. Something like this: `updateSelectInput(session,'Select3', choices=c("Please select an input", unique(candyData$value[candyData$Brand==input$Select1 & candyData$Candy==input$Select2])))` — SBista, Jan 29 '18 at 10:28
sure, works, but can't we hide this choice, fits the purpose but can be made clean? — Adam Shaw, Jan 29 '18 at 10:31
hey, I am trying to make the choice you mentioned above in bold using tags$b tag, but wont's help, can you help me with this to make the selectInput choice appear bold? — Adam Shaw, Jan 29 '18 at 11:17

Display the selectInput value in a R shiny widget box

1 Answers1

Linked