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 normaldiv
. e.g. classicuioutput("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 ofdiv
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
Post a Comment