Ршины: отображение графика при нажатии на многоугольник - PullRequest
Новая
       23

Ршины: отображение графика при нажатии на многоугольник

1 голос
/ 18 февраля 2020

Я Rshiny newb ie, очень хочу учиться, но сейчас я сталкиваюсь с проблемой, которую не могу преодолеть в одиночку, и я был бы очень признателен, если бы кто-то мог мне помочь! :)

Моя проблема (я думаю) довольно проста:

Я создал карту с моими полигонами, и мне удалось отобразить некоторые основные c данные, когда я нажимаю на них (посмотрите здесь) но я понятия не имею, как добавить барплот (например) под моей картой для каждого многоугольника, на который я нажимаю.

Может кто-нибудь помочь мне, как это сделать, пожалуйста? (после нескольких часов попыток мои глазные яблоки действительно собираются выскочить из их гнезд!)

Заранее большое спасибо!

Romain

Мой код: 

library(shiny)
library(leaflet)
library(dplyr)
library(magrittr)
library(devtools)
library(RColorBrewer)
library(rgdal)
library(sp)

communes <- readOGR("G:/Ateliers/Projet/communes.shp")
commmunes@data

nom_commune                 INSEE  Variable_1   Variable_2  Variable_3 area_sqkm
1    AUZEVILLE-TOLOSANE     31035         289     8.727212    9.336384  6.979758
2      CASTANET-TOLOSAN     31113          85     4.384877    8.891650  8.460724
3                LABEGE     31254         288     5.047406    2.031651  7.663404
4            PECHBUSQUE     31411         443     6.577743    8.120896  3.099422
5 RAMONVILLE-SAINT-AGNE     31446          95     2.601305    8.909278  6.236784
> 




ui <- fluidPage(
  leafletOutput("mymap"))


  #### SERVEUR R #####


  bins <- c(3,3.5,6,6.5,7,7.5,8,8.5)
  pal <- colorBin("YlOrRd", domain = communes$area_sqkm, bins = bins) 
  labels <- sprintf(
    "<strong>%s</strong><br/>%g km2",
    communes$nom_commun, communes$area_sqkm
  ) %>% lapply(htmltools::HTML)

server <- function(input, output, session) {
  output$mymap<-renderLeaflet(
    leaflet(communes) %>%
      addProviderTiles(providers$Stamen.TonerLite,
                       options = providerTileOptions(noWrap = TRUE)
      ) %>%
      setView(1.50, 43.54, zoom = 12) %>%
      addTiles()  %>% 
      addPolygons(fillColor = ~pal(area_sqkm),
                  weight = 2,
                  opacity = 1,
                  color = "white",
                  dashArray = "3",
                  fillOpacity = 0.7,
                  highlight = highlightOptions(
                    weight = 5,
                    color = "#666",
                    dashArray = "",
                    fillOpacity = 0.7,
                    bringToFront = TRUE),
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto")) %>% 
      addLegend(pal = pal, values = ~area_sqkm, opacity = 0.7, title = NULL,
                position = "bottomright")
  )
}     


shinyApp(ui = ui, server=server)

Данные, которые я хотел бы отобразить на своих диаграммах, это переменные 1,2 и 3: 

data <- read.csv("G:/Ateliers/Projet/communes.csv", sep=";")
data

nom_commune                 INSEE  Variable_1   Variable_2  Variable_3 area_sqkm
1    AUZEVILLE-TOLOSANE     31035         289     8.727212    9.336384  6.979758
2      CASTANET-TOLOSAN     31113          85     4.384877    8.891650  8.460724
3                LABEGE     31254         288     5.047406    2.031651  7.663404
4            PECHBUSQUE     31411         443     6.577743    8.120896  3.099422
5 RAMONVILLE-SAINT-AGNE     31446          95     2.601305    8.909278  6.236784
>

1 Ответ

0 голосов
/ 18 февраля 2020

Вот пример блестящего приложения с другими данными, так как у меня нет доступа к вашим данным формы для карты. Я считаю, что это может сделать то, что вам нужно, и может быть адаптировано к вашим потребностям.

Я бы создал reactiveVal для хранения id области многоугольника, по которой щелкнули (эта переменная хранит input$mymap_shape_click$id). Ваши данные, используемые в addPolygons, должны иметь id для ссылки.

На вашем графике (или в отдельном выражении reactive) вы можете фильтровать данные на основе reactiveVal, содержащего id. 

library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(ggplot2)
library(tidyverse)

arcgis_data = st_read("http://data.phl.opendata.arcgis.com/datasets/bc2b2e8e356742568e43b0128c344d03_0.geojson")

arcgis_data$id <- 1:nrow(arcgis_data)  ## Add an 'id' value to each shape

plot_data <- read.table(text =
"id nom_commune                 INSEE  Variable_1   Variable_2  Variable_3 area_sqkm
1    AUZEVILLE-TOLOSANE     31035         289     8.727212    9.336384  6.979758
2      CASTANET-TOLOSAN     31113          85     4.384877    8.891650  8.460724
3                LABEGE     31254         288     5.047406    2.031651  7.663404
4            PECHBUSQUE     31411         443     6.577743    8.120896  3.099422
5 RAMONVILLE-SAINT-AGNE     31446          95     2.601305    8.909278  6.236784", header = T, stringsAsFactors = F
) 

ui <- fluidPage(
  leafletOutput(outputId = "mymap"),
  plotOutput(outputId = "myplot")
)

server <- function(input, output){

  ## use reactive value to store the id from observing the shape click
  rv <- reactiveVal()

  output$mymap <- renderLeaflet({
    leaflet() %>% 
      addPolygons(data = arcgis_data %>% slice(1:5), layerId = ~id) %>% 
      addProviderTiles("CartoDB.Positron")
  })

  observeEvent(input$mymap_shape_click, {
    rv(input$mymap_shape_click$id)
  })

  ## you can now plot your plot based on the id of region selected
  output$myplot <- renderPlot({
    plot_data %>%
      filter(id == rv()) %>%
      pivot_longer(cols = starts_with("Variable"), names_to = "Variable", values_to = "Value") %>%
      ggplot(aes(x = Variable, y = Value)) +
        geom_col()
  })

}

shinyApp(ui, server)

Редактировать : Для загруженных данных вам не нужно добавлять отдельный id для communes. Вместо этого вы можете сопоставить по имени (nom_commune). Вы можете использовать это в своем layerId вместо этого. Похоже, это должно работать. Я извлек некоторую дополнительную информацию о метке, так как она отсутствовала в скачанном мной файле .shp. 

library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(ggplot2)
library(tidyverse)

communes <- readOGR("communes_ok.shp")

ui <- fluidPage(
  leafletOutput(outputId = "mymap"),
  plotOutput(outputId = "myplot")
)

server <- function(input, output){

  ## use reactive values to store the id from observing the shape click
  rv <- reactiveVal()

  output$mymap<-renderLeaflet(
    leaflet(communes) %>%
      addProviderTiles(providers$Stamen.TonerLite,
                       options = providerTileOptions(noWrap = TRUE)) %>%
      setView(1.50, 43.54, zoom = 12) %>%
      addTiles()  %>% 
      addPolygons(fillColor = "blue",
                  weight = 2,
                  opacity = 1,
                  color = "white",
                  dashArray = "3",
                  fillOpacity = 0.3,
                  highlight = highlightOptions(
                    weight = 5,
                    color = "#666",
                    dashArray = "",
                    fillOpacity = 0.7,
                    bringToFront = TRUE),
                  layerId = ~nm_cmmn)
  )

  observeEvent(input$mymap_shape_click, {
    rv(input$mymap_shape_click$id)
  })

  ## you can now 'output' your generated data however you want
  output$myplot <- renderPlot({
    if (is.null(rv())) return (NULL)
    plot_data %>%
      filter(nom_commune == rv()) %>%
      pivot_longer(cols = starts_with("Variable"), names_to = "Variable", values_to = "Value") %>%
      ggplot(aes(x = Variable, y = Value)) +
        geom_col()
  })

}

shinyApp(ui, server)
...