r - How to display (advanced) customed popups for leaflet in Shiny? -


i using r shiny build web applications, , of them leveraging great leaflet features.

i create customed , advanced popup, not know how proceed.

you can see can in project created post on github, or directly in shinyapp.io here

the more complex popup is, weirdest code is, sort of combining r , html in strange way (see way define custompopup'i' in server.r)..

is there better way proceed? practices build such popups? if plan display chart depending on marker being clicked, should build them in advance, or possible build them 'on fly'? how can that?

many in advance views on this, please not hesitate share answer here or directly change github examples!

regards

i guess post still has relevance. here solution on how add possible interface output leaflet popups.

we can achieve doing following steps:

  • insert popup ui element as character inside leaflet standard popup field. character means, no shiny.tag, merely normal div. e.g. classic uioutput("myid") becomes <div id="myid" class="shiny-html-output"><div>.

  • popups inserted special div, leaflet-popup-pane. add eventlistener monitor if content changes. (note: if popup disappears, means children of div removed, no question of visibility, of existence.)

  • when child appended, i.e. popup appearing, bind shiny inputs/outputs inside popup. thus, lifeless uioutput filled content it's supposed be. (one would've hoped shiny automatically, fails register output, since filled in leaflets backend.)

  • when popup deleted, shiny fails unbind it. thats problematic, if open popup once again, , throws exception (duplicate id). once deleted document, cannot unbound anymore. clone deleted element disposal-div can unbound properly , delete good.

i created sample app (i think) shows full capabilities of workaround , hope designed easy enough, can adapt it. of app show, please forgive has irrelevant parts.

library(leaflet) library(shiny)  runapp(   shinyapp(     ui = shinyui(       fluidpage(          # copy part here script , disposal-div         uioutput("script"),         tags$div(id = "garbage"),         # end of copy.          leafletoutput("map"),         verbatimtextoutput("showcase")       )     ),      server = function(input, output, session){        # show       text <- null       makereactivebinding("text")        output$showcase <- rendertext({text})        output$popup1 <- renderui({         actionbutton("go1", "go1")       })        observeevent(input$go1, {         text <<- paste0(text, "\n", "button 1 reactive.")       })        output$popup2 <- renderui({         actionbutton("go2", "go2")       })        observeevent(input$go2, {         text <<- paste0(text, "\n", "button 2 reactive.")       })        output$popup3 <- renderui({         actionbutton("go3", "go3")       })        observeevent(input$go3, {         text <<- paste0(text, "\n", "button 3 reactive.")       })       # end: show        # copy part.       output$script <- renderui({         tags$script(html('           var target = document.queryselector(".leaflet-popup-pane");            var observer = new mutationobserver(function(mutations) {             mutations.foreach(function(mutation) {               if(mutation.addednodes.length > 0){                 shiny.bindall(".leaflet-popup-content");               };               if(mutation.removednodes.length > 0){                 var popupnode = mutation.removednodes[0].childnodes[1].childnodes[0].childnodes[0];                  var garbagecan = document.getelementbyid("garbage");                 garbagecan.appendchild(popupnode);                  shiny.unbindall("#garbage");                 garbagecan.innerhtml = "";               };             });               });            var config = {childlist: true};            observer.observe(target, config);         '))       })       # end copy        # function lighten code. here can see how insert popup.       popupmaker <- function(id){         as.character(uioutput(id))       }        output$map <- renderleaflet({         leaflet() %>%            addtiles() %>%           addmarkers(lat = c(10, 20, 30), lng = c(10, 20, 30), popup = lapply(paste0("popup", 1:3), popupmaker))       })     }   ), launch.browser = true ) 

note: 1 might wonder, why script added server side. encountered, otherwise, adding eventlistener fails, because leaflet map not initialized yet. bet jquery knowledge there no need trick.

solving has been tough job, think worth time, leaflet maps got utility. have fun fix , please ask, if there questions it!


Comments

Popular posts from this blog

java - Could not locate OpenAL library -

c++ - Delete matches in OpenCV (Keypoints and descriptors) -

sorting - opencl Bitonic sort with 64 bits keys -