Accessing a data frame produced in a different RenderPlot

[josephlewis1992]

I've written a Shiny app that allows the user to select two points on a raster, resulting in the computation of a route using different parameters.

The visualisation of the route is only one component I want to happen. I also want to be able to create summary statistics of the route and show these in a different plot (so the route is shown on the left, and the statistics on the right).

However, I'm not sure how to make the route accessible within another Plot. What I want to be accessible to the other Plot is the

elevation <- data.frame(extract(dem, AtoB4))  

Elevation will then be used to create the summary statistics that will be shown in the right column.

Any thoughts on how to do this is appreciated. Recommendations of a different way to do it completely is also appreciated.

Reproducible example (current version view-able here: https://josephlewis1992.shinyapps.io/methodology/):

ui.R

ui <- fluidPage(

  titlePanel("xx"),


  # Sidebar layout with a input and output definitions 
  fluidRow(

    # Inputs
    column(width = 2,
      p("Drag a box on the Elevation plot to generate Least Cost Paths using different number of neighbours"),
      p("Least Cost Path generated using",strong("4 neighbours"), style = "color:red"),
      p("Least Cost Path generated using",strong("8 neighbours"), style = "color:black"),
      p("Least Cost Path generated using",strong("16 neighbours"), style = "color:blue")
    ),
    # Outputs
    column(4,
      plotOutput(outputId = "mapPlot", brush = "plot_brush")
      ), 
    column(6,
           plotOutput(outputId = "stats_plots"))
    )
  )

server.R

library(shiny)
library(raster)
library(gdistance)
library(sp)
library(rgdal)

dem <- raster(system.file("external/maungawhau.grd", package="gdistance"))


# Define server function required to create the scatterplot

conductance_calc <- function(input_dem, neighbours) {
  altDiff <- function(x){x[2] - x[1]}
  hd <- transition(input_dem, altDiff, neighbours, symm=FALSE)
  slope <- geoCorrection(hd)
  adj <- adjacent(input_dem, cells=1:ncell(input_dem), pairs=TRUE, directions=16)
  speed <- slope
  speed[adj] <- 6 * exp(-3.5 * abs(slope[adj] + 0.05))
  Conductance <- geoCorrection(speed)
  return(Conductance)
}

server <- function(input, output) {

  output$mapPlot <- renderPlot( {

    plot(dem, axes = FALSE, legend = FALSE)
    Conductance <-conductance_calc(dem, 16)

        if(is.null(input$plot_brush)) return("NULL\n")
      A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
      B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])

      AtoB16 <- shortestPath(Conductance, A, B, output="SpatialLines")

      ###

      Conductance <- conductance_calc(dem, 8)

      if(is.null(input$plot_brush)) return("NULL\n")
      A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
      B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])

      AtoB8 <- shortestPath(Conductance, A, B, output="SpatialLines")

      ###

      Conductance <-conductance_calc(dem, 4)

      if(is.null(input$plot_brush)) return("NULL\n")
      A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
      B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])

      AtoB4 <- shortestPath(Conductance, A, B, output="SpatialLines")

      ####
  plot(dem, axes = FALSE, legend = FALSE)
  lines(AtoB4, col = "red")
  lines(AtoB8, col = "black")
  lines(AtoB16, col = "blue")

  elevation <<- data.frame(extract(dem, AtoB4))
  names(elevation) <- "metres"

  })
  output$stats_plots <- renderPlot( {



  })
} 

[ginberg]

Hi @josephlewis1992, it seems to me like you can benefit from (one or more) reactive expressions. Do you know how to use these?

For example, you could have one reactive that returns all the Ato objects and call this reactive in both the mapPlot and stats_plots. Since you have the Ato objects then in your stats_plot, the elevation variable can be created there.

[josephlewis1992]

Hi @ginberg

Thanks for the response. I'll look more into reactive expression and work out how to implement them.

In your example, the reactive would contain the plot_brush component, and then if the user 'brushes' over the plot, then the reactive is called in the mapPlot and stats_plots?

[ginberg]

Hi, my previous answer was a bit too fast, sorry for that. I see that the plot_brush is part of the mapPlot, so it doesn't work when calling this input variable outsite the mapPlot. What you can do instead is to put the elevation result in a reactiveValues, see below.

library(shiny)
library(raster)
library(gdistance)
library(sp)
library(rgdal)

dem <- raster(system.file("external/maungawhau.grd", package="gdistance"))


# Define server function required to create the scatterplot

conductance_calc <- function(input_dem, neighbours) {
  altDiff <- function(x){x[2] - x[1]}
  hd <- transition(input_dem, altDiff, neighbours, symm=FALSE)
  slope <- geoCorrection(hd)
  adj <- adjacent(input_dem, cells=1:ncell(input_dem), pairs=TRUE, directions=16)
  speed <- slope
  speed[adj] <- 6 * exp(-3.5 * abs(slope[adj] + 0.05))
  Conductance <- geoCorrection(speed)
  return(Conductance)
}

server <- function(input, output) {
  
  data <- reactiveValues(elevation = NULL)
  
  output$mapPlot <- renderPlot( {
    
    plot(dem, axes = FALSE, legend = FALSE)
    Conductance <-conductance_calc(dem, 16)
    
    if(is.null(input$plot_brush)) return("NULL\n")
    A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
    B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])
    
    AtoB16 <- shortestPath(Conductance, A, B, output="SpatialLines")
    
    ###
    
    Conductance <- conductance_calc(dem, 8)
    
    if(is.null(input$plot_brush)) return("NULL\n")
    A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
    B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])
    
    AtoB8 <- shortestPath(Conductance, A, B, output="SpatialLines")
    
    ###
    
    Conductance <-conductance_calc(dem, 4)
    
    if(is.null(input$plot_brush)) return("NULL\n")
    A <- c(as.numeric(unlist(input$plot_brush))[1], as.numeric(unlist(input$plot_brush))[3])
    B <- c(as.numeric(unlist(input$plot_brush))[2], as.numeric(unlist(input$plot_brush))[4])
    
    AtoB4 <- shortestPath(Conductance, A, B, output="SpatialLines")
    
    ####
    plot(dem, axes = FALSE, legend = FALSE)
    lines(AtoB4, col = "red")
    lines(AtoB8, col = "black")
    lines(AtoB16, col = "blue")
    
    elevation <- data.frame(extract(dem, AtoB4))
    names(elevation) <- "metres"
    data$elevation <- elevation
  })
  
  output$stats_plots <- renderPlot( {
    req(!is.null(data$elevation))

    hist(data$elevation$metres)
  })
} 

[josephlewis1992]

Hi @ginberg,

Apologies for the delay in getting back to you.

This is perfect! Does exactly what I need. I'll look into reactiveValues more. Seems like something that I'll be using often.

Thanks again.

[ginberg]

Glad to hear this works for you @josephlewis1992 Could you please mark the solution to your question?

FAQ: How do I mark a solution?

If your question has been answered, don't forget to mark the solution! How do I mark a solution? Find the reply you want to mark as the solution and look for the row of small gray icons at the bottom of that reply. Click the one that looks like a box with a checkmark in it: [image] Hovering over the mark solution button shows the label, "Select if this reply solves the problem". If you don't see the mark solution button, try clicking the three dots button ( ••• ) to expand the full set of options. When a solution is chosen, the icon turns green and the hover label changes to: "Unselect if this reply no longer solves the problem". Success! [solution_reply_author] …