shiny app

[mdsumner]

From vapour

library(ggplot2)
library(shiny)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux
tfile <- "C:/data/ibcso_v1_is.tif" ## raadtools::topofile("gebco_14")
library(lazyraster)
library(raster)
lazy <- lazyraster(tfile)
world <- as_raster(lazy)
ui <- fluidPage(
  fluidRow(
    column(width = 8, class = "well",
           h4("Top plot controls bottom plot"),
           fluidRow(
             column(width = 12,
                    plotOutput("plot2", height = 500,
                               brush = brushOpts(
                                 id = "plot2_brush",
                                 resetOnNew = TRUE
                               )
                    )
             )),
           fluidRow(
             column(width = 12,
                    plotOutput("plot3", height = 600)
             )
           )
    )

  )
)

server <- function(input, output) {

  # -------------------------------------------------------------------
  # Single zoomable plot (on left)
  ranges <- reactiveValues(x = NULL, y = NULL)

  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observeEvent(input$plot1_dblclick, {
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)

    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })

  # -------------------------------------------------------------------
  # Linked plots (middle and right)
  ranges2 <- reactiveValues(x = NULL, y = NULL)

  output$plot2 <- renderPlot({
    image(world, useRaster = TRUE, col = grey(seq(0, 1, length = 64)), asp = 1)
  })

  output$plot3 <- renderPlot({
    xx <- if (!is.null(ranges2$x)) as_raster(crop(lazy, raster::extent(ranges2$x, ranges2$y))) else as_raster(lazy)
    plot(xx, col = viridis::inferno(64), legend = FALSE)
  })

  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observe({
    brush <- input$plot2_brush
    if (!is.null(brush)) {
      ranges2$x <- c(brush$xmin, brush$xmax)
      ranges2$y <- c(brush$ymin, brush$ymax)

    } else {
      ranges2$x <- NULL
      ranges2$y <- NULL
    }
  })

}

shinyApp(ui, server)