通过修改重现 ebailey78/shinyMenus 示例

Question

我正在尝试重现 ebailey78/shinyMenus example 稍作改动

在此示例中，当用户右键单击绘图时会出现三个单选按钮，根据用户选择的单选按钮，绘图会更改为 Normal、Uniform 或 LogNormal。

除了单选按钮，我正在尝试做同样的事情。我不想在右键单击时显示单选按钮，而是希望用户看到常规菜单选项，如 Normal、Lognormal、Uniform (no radio button)。

现在这就是我所做的，当用户单击鼠标右键时，它不会显示单选按钮，但会显示 Quick Dropdown。如何摆脱 Quick Dropdown 并使其成为常规下拉菜单并对用户选择做出反应？非常感谢任何指示或建议。提前致谢。

#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)

Answer 1

你应该使用 smAction。请参阅下面的示例

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))
                })
            }))

        })

通过修改重现 ebailey78/shinyMenus 示例

Reproducing ebailey78/shinyMenus example with modification

javascript

r

shiny

shinybs