Materials for Shiny Gadgets webinar

Author: garrettgman

29-Shiny-Gadgets/brush-gadget.R

@@ -0,0 +1,54 @@
+library(shiny)
+library(miniUI)
+library(ggplot2)
+
+pick_points <- function(data, x, y) {
+  ui <- miniPage(
+    gadgetTitleBar(paste("Select points")),
+    miniContentPanel(padding = 0,
+      plotOutput("plot1", height = "100%", brush = "brush")
+    ),
+    miniButtonBlock(
+      actionButton("add", "", icon = icon("thumbs-up")),
+      actionButton("sub", "", icon = icon("thumbs-down")),
+      actionButton("none", "" , icon = icon("ban")),
+      actionButton("all", "", icon = icon("refresh"))
+    )
+  )
+
+  server <- function(input, output) {
+    # For storing selected points
+    vals <- reactiveValues(keep = rep(TRUE, nrow(data)))
+
+    output$plot1 <- renderPlot({
+      # Plot the kept and excluded points as two separate data sets
+      keep    <- data[ vals$keep, , drop = FALSE]
+      exclude <- data[!vals$keep, , drop = FALSE]
+
+      ggplot(keep, aes_(x, y)) +
+        geom_point(data = exclude, color = "grey80") +
+        geom_point()
+    })
+
+    # Update selected points
+    selected <- reactive({
+      brushedPoints(data, input$brush, allRows = TRUE)$selected_
+    })
+    observeEvent(input$add,  vals$keep <- vals$keep | selected())
+    observeEvent(input$sub,  vals$keep <- vals$keep & !selected())
+    observeEvent(input$all,  vals$keep <- rep(TRUE, nrow(data)))
+    observeEvent(input$none, vals$keep <- rep(FALSE, nrow(data)))
+
+    observeEvent(input$done, {
+      stopApp(vals$keep)
+    })
+    observeEvent(input$cancel, {
+      stopApp(NULL)
+    })
+
+  }
+
+  runGadget(ui, server)
+}
+# pick_points(mtcars, ~wt, ~mpg)
+# pick_points(ggplot2::mpg, aes(displ, hwy))

29-Shiny-Gadgets/get_password.R

@@ -0,0 +1,22 @@
+library(miniUI)
+library(shiny)
+
+get_password <- function() {
+  ui <- miniPage(
+    gadgetTitleBar("Please enter your password"),
+    miniContentPanel(
+      passwordInput("password", "")
+    )
+  )
+
+  server <- function(input, output) {
+    observeEvent(input$done, {
+      stopApp(input$password)
+    })
+    observeEvent(input$cancel, {
+      stopApp(stop("No password.", call. = FALSE))
+    })
+  }
+
+  runGadget(ui, server, viewer = dialogViewer("Password", height = 200))
+}

29-Shiny-Gadgets/shiny-gadgets-webinar.pdf

@@ -0,0 +1,51 @@
+library(shiny)
+library(miniUI)
+library(leaflet)
+library(ggplot2)
+
+tab_app <- function() {
+  ui <- miniPage(
+    gadgetTitleBar("Shiny gadget example"),
+    miniTabstripPanel(
+      miniTabPanel("Parameters", icon = icon("sliders"),
+        miniContentPanel(sliderInput("year", "Year", 1978, 2010, 2000))
+      ),
+      miniTabPanel("Visualize", icon = icon("area-chart"),
+        miniContentPanel(plotOutput("cars", height = "100%"))
+      ),
+      miniTabPanel("Map", icon = icon("map-o"),
+        miniContentPanel(padding = 0, leafletOutput("map", height = "100%")),
+        miniButtonBlock(actionButton("resetMap", "Reset"))
+      ),
+      miniTabPanel("Data", icon = icon("table"),
+        miniContentPanel(DT::dataTableOutput("table"))
+      )
+    )
+  )
+  
+  server <- function(input, output, session) {
+    output$cars <- renderPlot({
+      require(ggplot2)
+      ggplot(cars, aes(speed, dist)) + geom_point()
+    })
+  
+    output$map <- renderLeaflet({
+      force(input$resetMap)
+  
+      leaflet(quakes, height = "100%") %>% addTiles() %>%
+        addMarkers(lng = ~long, lat = ~lat)
+    })
+  
+    output$table <- DT::renderDataTable({
+      diamonds
+    })
+  
+    observeEvent(input$done, {
+      stopApp(TRUE)
+    })
+  }
+  
+  runGadget(shinyApp(ui, server), viewer = paneViewer())  
+}
+
+# tab_app()