shinyapps deployment scripts

Author: cpsievert

_redirects

@@ -1,6 +1,7 @@
 https://plotly-book.cpsievert.me/* https://plotly-r.com/:splat 301!
 
-# redirect some links from from the 1st edition
+# redirect some links from the 1st edition
+
 https://plotly-r.com/plot-ly-for-collaboration.html https://plotly-r.com
 
 https://plotly-r.com/extending-ggplotly.html https://plotly-r.com/improving-ggplotly.html
@@ -16,3 +17,6 @@ https://plotly-r.com/linking-views-without-shiny.html https://plotly-r.com/clien
 https://plotly-r.com/shiny-plotly-inputs.html https://plotly-r.com/linking-views-with-shiny.html#shiny-plotly-inputs
 
 https://plotly-r.com/merging-plotly-objects.html https://plotly-r.com/arranging-views.html#arranging-plotly-objects
+
+
+https://plotly-r.com/interactives/shiny-drag-brush.html https://testing-apps.shinyapps.io/shiny-drag-brush

code/3Devents/app.R

@@ -0,0 +1,5 @@
+library(plotly)
+
+shiny::shinyAppDir(
+  system.file(package = "plotly", "examples", "shiny", "event_data_3D")
+)

code/discrete-event-data/app.R

@@ -0,0 +1,28 @@
+library(shiny)
+library(dplyr)
+library(plotly)
+
+ui <- fluidPage(
+  plotlyOutput("bars"),
+  verbatimTextOutput("click")
+)
+
+classes <- sort(unique(mpg$class))
+
+server <- function(input, output, session) {
+
+  output$bars <- renderPlotly({
+    ggplot(mpg, aes(class, fill = drv, customdata = drv)) + geom_bar()
+  })
+
+  output$click <- renderPrint({
+    d <- event_data("plotly_click")
+    if (is.null(d)) return("Click a bar")
+    mpg %>%
+      filter(drv %in% d$customdata) %>%
+      filter(class %in% classes[d$x])
+  })
+
+}
+
+shinyApp(ui, server)

code/event-priority/app.R

@@ -0,0 +1,29 @@
+library(shiny)
+library(plotly)
+
+ui <- fluidPage(
+  plotlyOutput("p"),
+  textOutput("time1"),
+  textOutput("time2")
+)
+
+server <- function(input, output, session) {
+
+  output$p <- renderPlotly({
+    plot_ly(x = 1:2, y = 1:2, size = I(c(100, 150)))  %>%
+      add_markers()
+  })
+
+  output$time1 <- renderText({
+    event_data("plotly_click")
+    paste("Input priority: ", Sys.time())
+  })
+
+  output$time2 <- renderText({
+    event_data("plotly_click", priority = "event")
+    paste("Event priority: ", Sys.time())
+  })
+
+}
+
+shinyApp(ui, server)

code/interactive-lm/app.R

@@ -0,0 +1,5 @@
+library(plotly)
+
+shiny::shinyAppDir(
+  system.file(package = "plotly", "examples", "shiny", "drag_markers")
+)

code/plotlyEvents/app.R

@@ -0,0 +1,5 @@
+library(plotly)
+
+shiny::shinyAppDir(
+  system.file(package = "plotly", "examples", "shiny", "event_data")
+)

code/shiny-corrplot/app.R

@@ -0,0 +1,46 @@
+library(shiny)
+library(plotly)
+
+# cache computation of the correlation matrix
+correlation <- round(cor(mtcars), 3)
+
+ui <- fluidPage(
+  plotlyOutput("heat"),
+  plotlyOutput("scatterplot")
+)
+
+server <- function(input, output, session) {
+
+  output$heat <- renderPlotly({
+    plot_ly(source = "heat_plot") %>%
+      add_heatmap(
+        x = names(mtcars),
+        y = names(mtcars),
+        z = correlation
+      )
+  })
+
+  output$scatterplot <- renderPlotly({
+    # if there is no click data, render nothing!
+    clickData <- event_data("plotly_click", source = "heat_plot")
+    if (is.null(clickData)) return(NULL)
+
+    # Obtain the clicked x/y variables and fit linear model to those 2 vars
+    vars <- c(clickData[["x"]], clickData[["y"]])
+    d <- setNames(mtcars[vars], c("x", "y"))
+    yhat <- fitted(lm(y ~ x, data = d))
+
+    # scatterplot with fitted line
+    plot_ly(d, x = ~x) %>%
+      add_markers(y = ~y) %>%
+      add_lines(y = ~yhat) %>%
+      layout(
+        xaxis = list(title = clickData[["x"]]),
+        yaxis = list(title = clickData[["y"]]),
+        showlegend = FALSE
+      )
+  })
+
+}
+
+shinyApp(ui, server)

code/shiny-crossfilter-compare/app.R

@@ -0,0 +1,8 @@
+library(plotly)
+library(nycflights13)
+library(colourpicker)
+library(ggstat)
+
+shiny::shinyAppDir(
+  system.file(package = "plotly", "examples", "shiny", "crossfilter_compare")
+)

code/shiny-crossfilter-kde/app.R

@@ -0,0 +1,5 @@
+library(plotly)
+
+shiny::shinyAppDir(
+  system.file(package = "plotly", "examples", "shiny", "crossfilter_kde")
+)

code/shiny-crossfilter-naive/app.R

@@ -0,0 +1,37 @@
+library(shiny)
+library(plotly)
+library(dplyr)
+library(nycflights13)
+
+ui <- fluidPage(
+  plotlyOutput("arr_time"),
+  plotlyOutput("dep_time")
+)
+
+server <- function(input, output, session) {
+
+  output$arr_time <- renderPlotly({
+    p <- plot_ly(flights, x = ~arr_time, source = "arr_time")
+
+    brush <- event_data("plotly_brushing", source = "dep_time")
+    if (is.null(brush)) return(p)
+
+    p %>%
+      filter(between(dep_time, brush$x[1], brush$x[2])) %>%
+      add_histogram()
+  })
+
+  output$dep_time <- renderPlotly({
+    p <- plot_ly(flights, x = ~dep_time, source = "dep_time")
+
+    brush <- event_data("plotly_brushing", source = "arr_time")
+    if (is.null(brush)) return(p)
+
+    p %>%
+      filter(between(arr_time, brush$x[1], brush$x[2])) %>%
+      add_histogram()
+  })
+
+}
+
+shinyApp(ui, server)