CODEWITHSUNDEEP
rshiny
firmo23
firmo23

Reputation: 8404

Turn the selectInput label into a choice that is displayed by default and cannot be selected

I have the shiny dashboard below with a selectInput(). I was wondering if I could turn the label "Variable" into a choice which will be displayed by default instead of "Cylinders" while "Cylindes" will still be the selected choice. Of course the label will not be displayed.It would be like: enter image description here

#app.r
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)

shinyApp(
  ui = dashboardPagePlus(
    header = dashboardHeaderPlus(

    ),
    sidebar = dashboardSidebar(
      selectInput("variable", "Variable:",
                  c("Cylinders" = "cyl",
                    "Transmission" = "am",
                    "Gears" = "gear"),
                  selected = "Cylinders")
    ),
    body = dashboardBody(
    ),
    rightsidebar = rightSidebar(),
    title = "DashboardPage"
  ),
  server = function(input, output) { }
)

Upvotes: 0

Views: 230

Answers (1)

bretauv
bretauv

Reputation: 8557

Using the shinyjs package, I determine whether the mouse is on the selectInput or not and adapt the content of selectInput with this condition.

First of all, I define a vector of choices. This is necessary since we need to update this vector whether the mouse is on the input or leaves the input, and I don't know another way of listing the possible values of an input.

Then, I define two events:

  • if the mouse is on the input, and if "Variable" is in the list of choices of the input (choices_input), then I update selectInput to remove "Variable" from this list of choices.

  • if the mouse leaves the input, and if "Variable" is not in the list of choices, I do the contrary.

Additionally, in the second event, you need to add an if statement to fix the value of selectInput to the choice you made, even after the mouse leaves.

Full code:

#app.r
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)

choices_input <- c("Variable",
                   "Cylinders" = "cyl",
                   "Transmission" = "am",
                   "Gears" = "gear")

shinyApp(
  ui = dashboardPagePlus(
    useShinyjs(),
    header = dashboardHeaderPlus(),
    sidebar = dashboardSidebar(
      selectInput("variable", "",
                  choices = choices_input,
                  selected = "Variable")
    ),
    body = dashboardBody(),
    rightsidebar = rightSidebar(),
    title = "DashboardPage"
  ),
  server = function(input, output, session) { 

    onevent("mouseenter", "variable",
            if ("Variable" %in% choices_input) {
              updateSelectInput(
                session = session,
                inputId = "variable",
                choices = c("Cylinders" = "cyl",
                            "Transmission" = "am",
                            "Gears" = "gear"),
                selected = input$variable)

              choices_input <<- c("Cylinders" = "cyl",
                                  "Transmission" = "am",
                                  "Gears" = "gear")
            })

    onevent("mouseleave", "variable", {
            if (!("Variable" %in% choices_input)) {
              updateSelectInput(
                session = session,
                inputId = "variable",
                choices = c("Variable",
                            "Cylinders" = "cyl",
                            "Transmission" = "am",
                            "Gears" = "gear"),
                selected = "Variable")

              choices_input <<- c("Variable",
                                  "Cylinders" = "cyl",
                                  "Transmission" = "am",
                                  "Gears" = "gear")
            }
            if(input$variable != "Variable"){
              updateSelectInput(
                session = session,
                inputId = "variable",
                choices = c("Variable",
                            "Cylinders" = "cyl",
                            "Transmission" = "am",
                            "Gears" = "gear"),
                selected = input$variable)
            }
      })

  }
)

Note: apparently, the mouse is considered to be "on the input" if it is just above the input, where the label (nothing in this case) should be. I don't know how to fix it for now.

Note 2: surely, you can fill the blank space when the mouse is on selectInput the first time by displaying a message (i.e adding another choice in choice_input) and by nesting an onclick() event (same package) in onevent() (to remove this message/choice if you click on the input).

Upvotes: 1

Related Questions