Блестящая брошюра - нажмите на маркер, чтобы открыть график/таблицу данных

Question

i m работает над лифтом с блестящим. Инструменты базовые, у меня есть карта с некоторыми маркерами (из таблицы с LONG и LAT).

Что я хочу сделать, так это открыть таблицу или график, когда я нажимаю на маркер.

Есть ли простой способ сделать это?

У вас действительно простой пример: у вас есть создатель на карте, вы нажимаете на маркер, и есть сюжет или таблица или jpeg, которые открываются?

Большое спасибо

Вот мой код:

library(leaflet) 
library(shiny) 
library(shinydashboard) 
library(plotly) 



# COULEUR et palette 

# gestion des donnees 
PALETTES = list() 
# Sites suivis 
PALETTES$Suivi$distr <- c("Terminé", "En cours","A venir","Visite") 
PALETTES$Suivi$colours <- c("#FF7F00", #orange suivi termine 
          "#009900", #vert suivi en cours 
          "#FFFF00", #jaune suivi planifié 
          "#436EEE" #bleu visite de site 
          ) 


don_sites=read.table("//Atlas.edf.fr//co//dpih-dtg-gre//4-DS.002//Serv61.004//Commun//1-Affaires//9-Charriage//3 - Pit-Tag//1. En cours/Sites.txt", header=TRUE,sep="\t") 
data.frame(don_sites) 



quakeIcons <- iconList(green = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_green6.png", iconWidth = 30, iconHeight =32), 
         orange = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_orange6.png", iconWidth = 30, iconHeight =32), 
         yellow = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_yellow6.png", iconWidth = 30, iconHeight =32), 
         blue = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_question.png", iconWidth = 30, iconHeight =32)) 


Carte_suivi_pit <- leaflet(data=don_sites) %>% setView(3.3, 44.9, zoom = 7) %>% 
    addLegend(position = "bottomright", 
      title="Suivis Pit", 
      colors = PALETTES$Suivi$colours, 
      labels = c(paste(PALETTES$Suivi$distr,sep="")), 
      opacity = 0.8) %>% 
    #addTiles('http://server.arcgisonline.com/ArcGIS/rest/services/World_Topo_Map/MapServer/tile/{z}/{y}/{x}')%>% 
    addProviderTiles("Thunderforest.Landscape", 
        options = providerTileOptions(noWrap = TRUE)) %>% 
    addMarkers(data=don_sites,popup=don_sites$LIB_LIEU,icon = ~quakeIcons[GROUP],clusterOptions = markerClusterOptions() 
      ) 


Carte_suivi_pit 

Вот мой стол:

ID RIVER LAT LON SUIVI GROUP 
1 Yukon 2.5 0.2 En cours orange 
2 ... 

Answer 1

Существует листовка пример файла здесь:

https://github.com/rstudio/shiny-examples/blob/ca20e6b3a6be9d5e75cfb2fcba12dd02384d49e3/063-superzip-example/server.R

# When map is clicked, show a popup with city info 
    observe({ 
    leafletProxy("map") %>% clearPopups() 
    event <- input$map_shape_click 
    if (is.null(event)) 
     return() 

    isolate({ 
     showZipcodePopup(event$id, event$lat, event$lng) 
    }) 
    }) 

Интернет демо (посмотреть, что происходит, когда вы нажимаете на пузырь): http://shiny.rstudio.com/gallery/superzip-example.html

На стороне клиента, когда щелчок на маркере происходит, JavaScript принимает это событие и общается с блестящей Сервер- которая может обрабатывать его как input$map_shape_click.

Answer 2

Вот еще один пример: taken from here и немного адаптирован. Когда вы нажмете маркер, соответствующая таблица изменится.

Кроме того, хороший ресурс это руководство здесь: https://rstudio.github.io/leaflet/shiny.html

library(leaflet) 
library(shiny) 
myData <- data.frame(
    lat = c(54.406486, 53.406486), 
    lng = c(-2.925284, -1.925284), 
    id = c(1,2) 
) 
ui <- fluidPage(
    leafletOutput("map"), 
    p(), 
    tableOutput("myTable") 
) 
server <- shinyServer(function(input, output) { 
    data <- reactiveValues(clickedMarker=NULL) 
    # produce the basic leaflet map with single marker 
    output$map <- renderLeaflet(
    leaflet() %>% 
     addProviderTiles("CartoDB.Positron") %>% 
     addCircleMarkers(lat = myData$lat, lng = myData$lng, layerId = myData$id) 
) 
    # observe the marker click info and print to console when it is changed. 
    observeEvent(input$map_marker_click,{ 
    print("observed map_marker_click") 
    data$clickedMarker <- input$map_marker_click 
    print(data$clickedMarker) 
    output$myTable <- renderTable({ 
     return(
     subset(myData,id == data$clickedMarker$id) 
    ) 
    }) 
    }) 
}) 
shinyApp(ui, server) 

Answer 3

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

Этот код работает с таблицей, и быть изменен, чтобы показать «Graph_QJ», когда я нажимаю на маркер:

library(leaflet) 
library(shiny) 
library(shinydashboard) 
library(plotly) 






myData=read.table("//Atlas.edf.fr//co//dpih-dtg-gre//4-DS.002//Serv61.004//Commun//1-Affaires//9-Charriage//3 - Pit-Tag//1. En cours/Sites.txt", header=TRUE,sep="\t") 
data.frame(myData) 



quakeIcons <- iconList(green = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_green6.png", iconWidth = 30, iconHeight =32), 
         orange = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_orange6.png", iconWidth = 30, iconHeight =32), 
         yellow = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_yellow6.png", iconWidth = 30, iconHeight =32), 
         blue = makeIcon("//Atlas.edf.fr/co/dpih-dtg-gre/4-DS.002/Serv61.004/Commun/1-Affaires/9-Charriage/3 - Pit-Tag/1. En cours/R/icones/map_pin_question.png", iconWidth = 30, iconHeight =32)) 






shinyUI=dashboardPage(

    # Header 
    dashboardHeader(title = "Suivis Pit-Tag - Charriage",titleWidth = 450, 
        dropdownMenuOutput("messageMenu1"), 
        dropdownMenuOutput("messageMenu2"), 
        disable = FALSE), 

    # Barre de menu 
    dashboardSidebar(
     sidebarMenu(id="menu",menuItem("Les sites de mesures", tabName = "sites") 
    ) 
    ), #end dashboard sidebar 


    # Corps 
    dashboardBody(

    tabItem(tabName = "sites", 
      navbarPage(title = '',id = "visuobs", #fluid = TRUE, 

         tabPanel("Synthèse",value = "pr", 
           column(width=7,#premiere colonne 
             box(width = 12, solidHeader = FALSE, status = "primary", 
              leafletOutput("map",height = 700) 
             ) 
           ),#end premiere colonne 
           column(width=5,#deuxieme colonne 
             box(width =12, solidHeader = FALSE, status = "primary", 
             plotlyOutput('Graph_QJ',height = 400), 
             p(), 
             tableOutput("myTable") 
             ) 
           )#end deuxieme colonne 

         ) # end tab panel RR 

       ) # end navbar page 
    ) # end tab item 
) 
) # end dashboardbody 







server <- function(input, output, session) { 
    data <- reactiveValues(clickedMarker=NULL) 
    #Carto synthese mesures Pit 
    output$map <- renderLeaflet({ 

    map <- leaflet(data=myData) %>% setView(3.3, 44.9, zoom = 7) %>% 
     addLegend(position = "bottomright", 
       title="Suivis Pit", 
       colors = PALETTES$Suivi$colours, 
       labels = c(paste(PALETTES$Suivi$distr,sep="")), 
       opacity = 0.8) %>% 
     #addTiles('http://server.arcgisonline.com/ArcGIS/rest/services/World_Topo_Map/MapServer/tile/{z}/{y}/{x}')%>% 
     addProviderTiles("Thunderforest.Landscape", 
         options = providerTileOptions(noWrap = TRUE)) %>% 
     addMarkers(data=myData,popup=myData$LIB_LIEU,icon = ~quakeIcons[GROUP],clusterOptions = markerClusterOptions(), 
       layerId = myData$id) 


    map 




    }) # end renderLeaflet 

    output$Graph_QJ <- renderPlotly({ 


    Graph_QJ 



}) # end plotlyGraph 

    # observe si il y a un click sur un shape sur la carto 
    observeEvent(input$map_marker_click,{ 
    print("observed map_marker_click") 
    data$clickedMarker <- input$map_marker_click 
    print(data$clickedMarker) 
    output$myTable <- renderTable({ 
     return(
     subset(myData,id == data$clickedMarker$id) 
    ) 

    })  


    }) #end 

} 




shinyApp(shinyUI, server) 

Спасибо большое за помощь. Стеки скалы! ;)