シャイニーリーフレット - マーカーをクリックしてプロット/データテーブルを開きます

Question

リーフレットに光沢をつけて作業しています。ツールは基本的なもので、私はいくつかのマーカー（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

もう1つの例を示します。taken from hereと少し修正しました。マーカーをクリックすると、以下の表が適宜変更されます。

それとは別に、優れたリソースは、ここで、このマニュアルです：Nilsolの助けを借りて 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

（SAロットに感謝!!）私がクリックしたときに、私は今、IDに対応するテーブルを持っていますマーカー上にここに解決策があります。それは私がマーカーをクリックするとプロットを表示する方法でこのコードを変更するのに役立つでしょう、プロットはすでにどこかで行われ、彼の名前は "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) 

おかげで助けをたくさん。スタックロック！ ;）