Search code examples
javascriptrshinyshinybs

Reproducing ebailey78/shinyMenus example with modification


I am trying to reproduce ebailey78/shinyMenus example with a slight twist

In this example when the user right clicks on the plot three radio buttons appear and depending on what radio button user chooses the plot changes to either Normal, Uniform or LogNormal.

I am trying to do the same thing except the radiobutton. Instead of showing the radio button on right click I want the users to see regular menu options like Normal, Lognormal, Uniform (no radio button) .

Right now this is what I did , when the user does a right click it does not show radio buttons but it shows a Quick Dropdown. How do I get rid of Quick Dropdown and make it a regular Dropdown and react to user choice? Any pointers or suggestions are much appreciated. Thanks in advance.

#devtools::install_github("ebailey78/shinyMenus")

library(shiny)
library(shinyBS)
library(shinyMenus)

app <- shinyApp(
  ui = 
    fluidPage(
      smNavBar("testMenu", "shinyMB", full.width = TRUE, fixed = FALSE, 

               textInput("n", "Sample Size", value = 1000),
               smNavDropdown("Distribution",
                             smRadio("dist", "norm", "Normal", selected = TRUE),
                             smRadio("dist", "lnorm", "Lognormal"),
                             smRadio("dist", "unif", "Uniform")
               ),
               smQuickDropdown("qd2Test", parent = "navbar", "Quick Dropdown", c("Action 1", "Action 2", "Action 3"))
       ),

      smQuickDropdown("qdTest", "Quick Dropdown", c("Action 1", "Action 2", "Action 3")),
      plotOutput("testPlot"),
#       smContextMenu("context1", "testPlot", 
#                     smRadio("dist", "norm", "Normal", selected = TRUE),
#                     smRadio("dist", "lnorm", "Lognormal"),
#                     smRadio("dist", "unif", "Uniform")
#       )

        smContextMenu("context1","testPlot",

                      smQuickDropdown("dist", "Quick Dropdown", c("Normal", "Lognormal", "Uniform"))

                      )

    ),
  server = 
    function(input, output, session) {

      observeEvent(input$qdTest, ({print(input$qdTest)}))
      observeEvent(input[["Action 1"]], ({print(input[["Action 1"]])}))
      output$testPlot <- renderPlot({
        dist <- switch(input$dist,
                       norm = rnorm,
                       lnorm = rlnorm,
                       unif = runif
        )
        plot(dist(input$n))
      })
    }
)

runApp(app)

Solution

  • You should use smAction. See example below

    library(shiny)
    library(shinyBS)
    library(shinyMenus)
    
    app <- shinyApp(
        ui = 
            fluidPage(
                smNavBar("testMenu", "shinyMB", full.width = TRUE, fixed = FALSE, 
    
                         textInput("n", "Sample Size", value = 1000),
                         smNavDropdown("Distribution",
                                       smRadio("dist", "norm", "Normal", selected = TRUE),
                                       smRadio("dist", "lnorm", "Lognormal"),
                                       smRadio("dist", "unif", "Uniform")
                         ),
                         smQuickDropdown("qd2Test", parent = "navbar", "Quick Dropdown", c("Action 1", "Action 2", "Action 3"))
                ),
    
                smQuickDropdown("qdTest", "Quick Dropdown", c("Action 1", "Action 2", "Action 3")),
                plotOutput("testPlot"),
                #       smContextMenu("context1", "testPlot", 
                #                     smRadio("dist", "norm", "Normal", selected = TRUE),
                #                     smRadio("dist", "lnorm", "Lognormal"),
                #                     smRadio("dist", "unif", "Uniform")
                #       )
    
                smContextMenu("context1","testPlot",
    
                              smAction("action1", "Normal"),
                              smAction("action2", "Lognormal"),
                              smAction("action3", "Uniform")
    
                )
    
            ),
        server = 
            function(input, output, session) {
                output$testPlot <- renderPlot({
                    plot(rnorm(input$n))
                })
                observeEvent(input$action1, ({
                    output$testPlot <- renderPlot({
                        plot(rnorm(input$n))
                    })
                }))
                observeEvent(input$action2, ({
                    output$testPlot <- renderPlot({
                        plot(rlnorm(input$n))
                    })
                }))
                observeEvent(input$action3, ({
                    output$testPlot <- renderPlot({
                        plot(runif(input$n))
                    })
                }))
    
            })