Search code examples
rshinyr-leaflet

updatetabsetPanel from a leaflet popup link in R Shiny


Struggling R shiny beginner here. I'm having trouble grasping how to switch tabs in my two-tab sidebar (people | places) when a link in a label on a map in the main panel is clicked. I take it from looking at other, somewhat similar questions that updatetabsetPanel is the way to go. I've tried the following and it works fine updating the iframe when the "places" tab is active, but doesn't bring the "places" tab to the front when the "people" tab is active. I'm mostly unclear on how to use a "a href" here to spark the event that changes the tab.

ui

ui <- fluidPage(

  fluidRow(

  # ADDED SHINY JS
  useShinyjs(debug = TRUE),

    column(3,
           "DATA",


           tabsetPanel(id='lefttabsetPanel',

                       tabPanel(title='PLACES', value = "placestab",
                                tags$iframe(name="myiframe2",seamless="seamless",src="http://www.example.com/places.xml",height=600, width=320)
                       ), 
                       tabPanel(title='PEOPLE', value = "peopletab",

                                tags$iframe(name="myiframe",seamless="seamless",src="http://www.example.com/people.xml",height=600, width=320))

    )
    ),
    column(9,
           "MAPS",


  tabsetPanel(id='my_tabsetPanel',
              tabPanel('Map 1',

 # ADDED LINKS TO TABS THAT WORK
 a(id="peopletablink","link to peopletab",href="http://45.56.98.26:8080/exist/rest/db/madrid/xml/tds-people.xml#PERSCELESTINA", target="myiframe"),
                       a(id="placestablink","link to placestab",href="http://45.56.98.26:8080/exist/rest/db/madrid/xml/tds-placeography.xml#PLACEMADRID", target="myiframe2"),

                       leafletOutput(outputId="mymap", height = 600)   
              ), 
              tabPanel('Map 2', 
                       leafletOutput(outputId="mymap2", height = 600)   
              )


              )

  )
)
  )
)

global

server <- function(input,output, session){

  data <- reactive({
    x <- placeography
  })
  # Core wrapping function
  wrap.it <- function(x, len)
  { 
    sapply(x, function(y) paste(strwrap(y, len), 
                                collapse = "\n"), 
           USE.NAMES = FALSE)
  }
# NEW SHINYJS 
    shinyjs::onclick("peopletablink",  updateTabsetPanel(session, inputId="lefttabsetPanel", selected="peopletab"))
    shinyjs::onclick("placestablink",  updateTabsetPanel(session, inputId="lefttabsetPanel", selected="placestab"))


# OLD APPROACH

 # observeEvent(input$place_link, {
 #   updateTabsetPanel(session, "lefttabsetPanel", 'placetab')
 # }
 # )
  output$mymap <- renderLeaflet({

    m <- leaflet() %>%
      setView(lng=-3.6898447, lat=40.4142174, zoom=3 ) %>%

      #MAP--SATELLITE ESRI

      addProviderTiles("Esri.WorldImagery", group="Satellite") %>%

      # PLACES
      addPolygons(data = tdscountries,
        popup = mapply(function(x, y) {

# THE POPUP LINK I WANT TO CHANGE THE TAB--BUT DOESN'T WORK
            HTML(sprintf("<div class='leaflet-popup-scrolled' style='font-size:10px;max-width:200px;max-height:150px; '><b><a href='http://www.example.com/places.xml#%s' target='myiframe2' id='placestablink'>%s</a><BR><BR>Click for more details</div>", w,htmlEscape(x), y))},
            tdscountries$placeref,tdscountries$placename, SIMPLIFY = F),
        popupOptions = lapply(1:nrow(tdscountries), function(x,y) {
          popupOptions(direction='auto')}),weight = 0.75,  group = "Countries", fillColor ="gold") 

          })}

I output my tdscountries data here:

http://45.56.98.26/tdscountries.txt

Apologies if this is too similar to other questions--I looked at them all (along with the official Shiny documentation for updatetabsetPanel) and gave it a shot, but I'm clearly missing something.

UPDATE: I have almost got this working. I can now create links that switch the tabs and link deeper in the xml doc in the iframe using shinyjs (as suggested here: shiny:change tab when click on image), but the same a does not work in my leaflet popup links, so I'm still looking for a solution to that issue. I updated info above in case it's helpful to anyone in the future.


Solution

  • Finally figured this out and it was much simpler than I thought and doesn't require the shinyjs library. The answer was here and works for links in popups as well:

    Trying to integrate updateTabsetPanel with leaflet marker click in R Shiny?

    To update the code above. This works:

    ui

    ui <- fluidPage(
    
      fluidRow(
    
        column(3,
               "DATA",
    
    
               tabsetPanel(id='lefttabsetPanel',
    
                           tabPanel(title='PLACES', value = "placestab",
                                    tags$iframe(name="myiframe2",seamless="seamless",src="http://www.example.com/places.xml",height=600, width=320)
                           ), 
                           tabPanel(title='PEOPLE', value = "peopletab",
    
                                    tags$iframe(name="myiframe",seamless="seamless",src="http://www.example.com/people.xml",height=600, width=320))
    
        )
        ),
        column(9,
               "MAPS",
    
    
      tabsetPanel(id='my_tabsetPanel',
                  tabPanel('Map 1',
    
    
                           leafletOutput(outputId="mymap", height = 600)   
                  ), 
                  tabPanel('Map 2', 
                           leafletOutput(outputId="mymap2", height = 600)   
                  )
    
    
                  )
    
      )
    )
      )
    )
    

    global

    server <- function(input,output, session){
    
    # detect link clicked in leaflet popup and switch tabs
    
    observeEvent(input$linkclickplaces,{
        updateTabsetPanel(session, inputId="lefttabsetPanel", selected="placestab")
    
      })
      observeEvent(input$linkclickpeople,{
        updateTabsetPanel(session, inputId="lefttabsetPanel", selected="peopletab")
    
      })
    
      data <- reactive({
        x <- placeography
      })
      # Core wrapping function
      wrap.it <- function(x, len)
      { 
        sapply(x, function(y) paste(strwrap(y, len), 
                                    collapse = "\n"), 
               USE.NAMES = FALSE)
    
    output$mymap <- renderLeaflet({
    
        m <- leaflet() %>%
          setView(lng=-3.6898447, lat=40.4142174, zoom=3 ) %>%
    
          #MAP--SATELLITE ESRI
    
          addProviderTiles("Esri.WorldImagery", group="Satellite") %>%
    
          # PLACES
          addPolygons(data = tdscountries,
            popup = mapply(function(x, y) {
    
    # THE LEAFLET POPUP LINK THAT CHANGES THE TAB
                HTML(sprintf("<div class='leaflet-popup-scrolled' style='font-size:10px;max-width:200px;max-height:150px; '><b><a href='http://www.example.com/places.xml#%s' target='myiframe2' onclick='Shiny.onInputChange(\"linkclickplaces\",  Math.random())'>%s</a><BR><BR>Click for more details</div>", w,htmlEscape(x), y))},
                tdscountries$placeref,tdscountries$placename, SIMPLIFY = F),
            popupOptions = lapply(1:nrow(tdscountries), function(x,y) {
              popupOptions(direction='auto')}),weight = 0.75,  group = "Countries", fillColor ="gold") 
    
              })}
    
    

    Depending on how you are constructing your popup link, you will need to watch out for use and escaping of single and double quotes.

    Just one caveat/sticking point--in my case, the link in the leaflet popup also updates an iframe in the "places" tab with a link like this:

    <a href='http://www.example.com/places.xml#PLACEREF' target='myiframe2' onclick='Shiny.onInputChange(\"linkclickplaces\",  Math.random())'>PLACE NAME</a>
    

    The first time I click on a link that changes tabs, that first click does not update the iframe--a second click does. (Depending on the browser, the first click lands you at the top or bottom of the embedded xml document.) Once in the tab, single clicks allow you to move around in it. I'm looking for a solution to this problem, but in the meantime put instructions in the popup to double click links.