examples

examples/ex-drop-menu-inception.R

@@ -0,0 +1,50 @@
+if (interactive()) {
+  library(shiny)
+  library(shinyWidgets)
+
+  ui <- fluidPage(
+    tags$h2("Drop Menu Inception"),
+
+    dropMenu(
+      actionButton("open", "See what's inside"),
+      options = list(distance = 0),
+      arrow = FALSE,
+      trigger = c("mouseenter", "focus"),
+      dropMenu(
+        actionButton("open1", "Menu 1"),
+        "Menu 1",
+        placement = "right"
+      ),
+      dropMenu(
+        actionButton("open2", "Menu 2"),
+        trigger = "mouseenter",
+        "Menu 2",
+        placement = "right"
+      ),
+      dropMenu(
+        actionButton("open3", "Menu 3"),
+        trigger = "mouseenter",
+        dropMenu(
+          actionButton("open3a", "Menu 3 A"),
+          "Menu 3 A",
+          placement = "right"
+        ),
+        dropMenu(
+          actionButton("open3b", "Menu 3 B"),
+          trigger = "mouseenter",
+          "Menu 3 B",
+          placement = "right"
+        ),
+        placement = "right"
+      )
+    )
+
+  )
+
+  server <- function(input, output, session) {
+
+
+  }
+
+  shinyApp(ui, server)
+}

examples/ex-drop-menu-interaction.R

@@ -0,0 +1,49 @@
+if (interactive()) {
+  library(shiny)
+  library(shinyWidgets)
+
+  ui <- fluidPage(
+    tags$h2("Drop Menu interactions"),
+    dropMenu(
+      actionButton("myid", "See what's inside"),
+      "Drop menu content",
+      actionButton("hide", "Close menu"),
+      position = "right middle"
+    ),
+    tags$br(),
+    tags$p("Is drop menu opened?"),
+    verbatimTextOutput("isOpen"),
+    actionButton("show", "show menu"),
+    tags$br(),
+    tags$br(),
+    dropMenu(
+      actionButton("dontclose", "Only closeable from server"),
+      "Drop menu content",
+      actionButton("close", "Close menu"),
+      position = "right middle",
+      hideOnClick = FALSE
+    )
+  )
+
+  server <- function(input, output, session) {
+
+    output$isOpen <- renderPrint({
+      input$myid_dropmenu
+    })
+
+    observeEvent(input$show, {
+      showDropMenu("myid_dropmenu")
+    })
+
+    observeEvent(input$hide, {
+      hideDropMenu("myid_dropmenu")
+    })
+
+    observeEvent(input$close, {
+      hideDropMenu("dontclose_dropmenu")
+    })
+
+  }
+
+  shinyApp(ui, server)
+}

examples/ex-drop-menu-output.R

@@ -0,0 +1,30 @@
+if (interactive()) {
+  library(shiny)
+  library(shinyWidgets)
+
+  ui <- fluidPage(
+    tags$h2("Drop Menu xith Shiny Output"),
+    dropMenu(
+      actionButton("myid", "See what's inside"),
+      plotOutput("plot", width = "600px"),
+      sliderInput("n", "Number of obs.", 10, 500, 50)
+    ),
+    tags$br(),
+    dropMenu(
+      actionButton("see_table", "DT inside"),
+      DT::DTOutput(outputId = "table")
+    )
+  )
+
+  server <- function(input, output, session) {
+
+    output$plot <- renderPlot({
+      plot(density(rnorm(input$n)))
+    })
+
+    output$table <- DT::renderDT(iris)
+
+  }
+
+  shinyApp(ui, server)
+}

examples/ex-drop-menu.R

@@ -0,0 +1,71 @@
+if (interactive()) {
+  library(shiny)
+  library(shinyWidgets)
+
+  ui <- fluidPage(
+    tags$h3("drop example"),
+
+    dropMenu(
+      actionButton("go0", "See what"),
+      tags$div(
+        tags$h3("This is a dropdown"),
+        tags$ul(
+          tags$li("You can use HTML inside"),
+          tags$li("Maybe Shiny inputs"),
+          tags$li("And maybe outputs"),
+          tags$li("and should work in markdown")
+        )
+      ),
+      theme = "light-border",
+      placement = "right",
+      arrow = FALSE
+    ),
+
+    tags$br(),
+
+
+    dropMenu(
+      actionButton("go", "See what"),
+      tags$h3("Some inputs"),
+      sliderInput(
+        "obs", "Number of observations:",
+        min = 0, max = 1000, value = 500
+      ),
+      selectInput(
+        "variable", "Variable:",
+        c("Cylinders" = "cyl",
+          "Transmission" = "am",
+          "Gears" = "gear")
+      ),
+      pickerInput(
+        inputId = "pckr",
+        label = "Select all option",
+        choices = rownames(mtcars),
+        multiple = TRUE,
+        options = list(`actions-box` = TRUE)
+      ),
+      radioButtons(
+        "dist", "Distribution type:",
+        c("Normal" = "norm",
+          "Uniform" = "unif",
+          "Log-normal" = "lnorm",
+          "Exponential" = "exp")
+      )
+    ),
+    verbatimTextOutput("slider"),
+    verbatimTextOutput("select"),
+    verbatimTextOutput("picker"),
+    verbatimTextOutput("radio")
+  )
+
+  server <- function(input, output, session) {
+
+    output$slider <- renderPrint(input$obs)
+    output$select <- renderPrint(input$variable)
+    output$picker <- renderPrint(input$pckr)
+    output$radio <- renderPrint(input$dist)
+
+  }
+
+  shinyApp(ui, server)
+}