From e85fa61eac0fa136773bb241adf7d9c8d3d6fcbc Mon Sep 17 00:00:00 2001 From: pvictor Date: Tue, 14 Jan 2020 17:04:34 +0100 Subject: [PATCH] examples --- examples/ex-drop-menu-inception.R | 50 ++++++++++++++++++++ examples/ex-drop-menu-interaction.R | 49 ++++++++++++++++++++ examples/ex-drop-menu-output.R | 30 ++++++++++++ examples/ex-drop-menu.R | 71 +++++++++++++++++++++++++++++ 4 files changed, 200 insertions(+) create mode 100644 examples/ex-drop-menu-inception.R create mode 100644 examples/ex-drop-menu-interaction.R create mode 100644 examples/ex-drop-menu-output.R create mode 100644 examples/ex-drop-menu.R diff --git a/examples/ex-drop-menu-inception.R b/examples/ex-drop-menu-inception.R new file mode 100644 index 00000000..e4d46893 --- /dev/null +++ b/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) +} diff --git a/examples/ex-drop-menu-interaction.R b/examples/ex-drop-menu-interaction.R new file mode 100644 index 00000000..c121ec0f --- /dev/null +++ b/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) +} diff --git a/examples/ex-drop-menu-output.R b/examples/ex-drop-menu-output.R new file mode 100644 index 00000000..2ca9161c --- /dev/null +++ b/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) +} diff --git a/examples/ex-drop-menu.R b/examples/ex-drop-menu.R new file mode 100644 index 00000000..1297ad86 --- /dev/null +++ b/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) +}