Доступ к фрейму данных, созданному в другом RenderPlot - PullRequest
0 голосов
/ 04 сентября 2018

Я написал приложение Shiny, которое позволяет пользователю выбирать две точки на растре, что приводит к вычислению маршрута с использованием различных параметров.

Визуализация маршрута - это только один компонент, который я хочу реализовать. Я также хочу иметь возможность создавать сводную статистику маршрута и показывать ее на другом графике (чтобы маршрут показывался слева, а статистика - справа).

Однако я не уверен, как сделать маршрут доступным на другом участке. То, что я хочу быть доступным для другого сюжета, это

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

Высота будет использоваться для создания сводной статистики, которая будет отображаться в правом столбце.

Все мысли о том, как это сделать, приветствуются. Также приветствуются рекомендации другого способа сделать это полностью.

Воспроизводимый пример:

ui.R

# Define UI for application that plots features of movies 
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( {



  })
} 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...