воспроизводящих ebailey78/shinyMenus пример с модификацией

Question

Я пытаюсь воспроизвести ebailey78/shinyMenus example с небольшим поворотом

В этом примере, когда пользователь щелкает правый нажмет на сюжет трех радиокнопок появляются и в зависимости от того, что радио выбирает кнопку пользователя сюжет изменяется либо на Normal, Uniform, либо LogNormal.

Я пытаюсь сделать то же самое, кроме радиоблока. Вместо того, чтобы показывать переключатель правой кнопкой мыши, я хочу, чтобы пользователи видели обычные параметры меню, такие как Normal, Lognormal, Uniform (без переключателя).

Прямо сейчас это то, что я сделал, когда пользователь делает правый щелчок, он не показывает переключатели, но показывает 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)) 
       }) 
      })) 

     })