Can popupGraph support plotly::plot_ly on shiny leaflet?

[cywhale]

popupGraph can show plot_ly() graph correctly on leaflet (Rstudio viewer), but cannot work on shiny server. The popup panel show grey "NOT FOUND" (404 cannot find popup_graphs/tmp_1.html)

But ggplot2 graph is ok for both Rstudio and shiny. Thus, is there any way for popupGraph supporting plotly::plot_ly on shiny leaflet?

Here is a small example code: (app.R)

# Test plotly for popupGraph in mapview

library(shiny)
library(sf)
library(leaflet)
library(mapview)
library(mapedit)
library(magrittr)
library(plotly)
library(ggplot2)

# Define UI for application 
ui <- fluidPage(

  fluidRow(
      uiOutput("emod_ui")
  )
)

server <- function(input, output) {

  geopoly <- c(
    123.5, 132.25, 132.25, 123.5, 123.5,
    26.5, 26.5, 32.75,  32.75,  26.5
  ) %>% matrix(ncol=2,byrow=FALSE) %>% list() %>%
  st_polygon() %>%
  st_sfc(crs = 4326) 

  ## plot_ly graph is ok on leaflet (Rstudio viewer), but not work on shiny
  p <- plot_ly(data=data.frame(ID=letters[1:5], val=sample(100,5)), 
               labels = ~ID, values = ~val, type = 'pie') %>%
    layout(title = '',
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))  

  ## ggplot2 graph is ok for both Rstudio viewer and shiny
  g <- ggplot(data=data.frame(
         time = factor(c("Lunch","Dinner"), levels=c("Lunch","Dinner")), total_bill = c(14.89, 17.23)
         ), aes(x=time, y=total_bill, fill=time)) + geom_bar(colour="black", stat="identity")

  ns <- shiny::NS("eview") 

  #### Initialize leaflet map  
  lf0 <- reactive({
    leaflet() %>% addTiles() %>% setView(130, 30, zoom=5) %>%
      addPolygons(data=geopoly, popup=mapview::popupGraph(p)) #g is ok
  })

  output$emod_ui <- renderUI({
    editModUI("eview", width="100%", height="480px")
  })

  observe({
    callModule(editMod, "eview", isolate({lf0()}))
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

[tim-salabim]

Sorry for the late reply! I'll look into it, though likely not before December.

[whisp1986]

Hello, was there a resolution to this issue?

[cywhale]

Hello, was there a resolution to this issue?

I used an alternative way in my mapedit web app. Detect the mouse click on polygons (observeEvent({input[[ns("map_shape_click")]]},...) and open a wellPanel with plotlyOutput(), then plot my plot_ly() result on this panel.

[whisp1986]

Thank you, do you mind posting some example code? - I'm trying to use insertUI with an absolute panel, with plot_ly...it's working but can't be dragged when placed inside the leaflet map.

[cywhale]

Sure, please try this example https://github.com/cywhale/ODB/blob/master/mapedit_plotly_example/app.R

absolutepanel should be draggable if set draggable = TRUE

[whisp1986]

Thank you! - I also fixed the problem by wrapping the whole panel in jqui draggable context.

[JimColl]

I just encountered this error and thought I would bump this with a non working example. Is there a slightly easier way to make this work?

library(leaflet) 
library(htmlwidgets)
library(htmltools)
library(plotly)
# library(dygraphs)
# library(xts)
# library(mapview)
# library(listviewer)
library(mapedit)
library(leafpop)
library(shinydashboard)

df <- read.csv(textConnection(
  "Name,Lat,Long
  Samurai Noodle,47.597131,-122.327298
  Kukai Ramen,47.6154,-122.327157
  Tsukushinbo,47.59987,-122.326726"
))

ui <- dashboardPage(
  skin = "green",
  dashboardHeader(title = "Shiny and Plotly popup"),
  dashboardSidebar(
    sidebarMenu(
      menuItem(
        "Maps", 
        tabName = "maps", 
        icon = icon("globe"),
        menuSubItem("No popup", tabName = "NoPopup", icon = icon("map")),
        menuSubItem("With popup", tabName = "Popup", icon = icon("map"))
      )
    )
  ),
  dashboardBody(
    tags$style(type = "text/css", "#currentConditions {height: calc(100vh - 150px) !important;}"
               , "#basedata {height: calc(100vh - 150px) !important;}"),
    tabItems(
      tabItem(
        tabName = "NoPopup",
        box(
          title = paste("No Popup"),
          collapsible = TRUE,
          width = "100%",
          height = "100%",
          leafletOutput("NoPopup")
        )
      ),
      tabItem(
        tabName = "Popup",
        box(
          title = paste("Popup"),
          collapsible = TRUE,
          width = "100%",
          height = "100%",
          leafletOutput("Popup")
        )
      )
    )
  )

)

server <- function(input, output) {

  output$Popup <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
      addMarkers(
        data = df,
        popup = leafpop::popupGraph(lapply(
          seq_along(df),
          function(x) {
            plot_ly(x=~1:20, y=~runif(20)) %>%
              add_markers() %>%
              as.tags() %>%
              {tags$div(style="width:300px;", .)} %>%
              as.character()
          }
        )
      )) %>%
      onRender(
        "
        function(el,x) {
        this.on('popupopen', function() {HTMLWidgets.staticRender();})
        }
        ") %>%
      add_deps("plotly") %>%
      htmltools::attachDependencies(plotly:::plotlyMainBundle(), append = TRUE) %>%
      htmltools::attachDependencies(crosstalk::crosstalkLibs(), append = TRUE) %>%
      browsable()
  })

  output$NoPopup <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
      addMarkers(data = df)
  })
}

shinyApp(ui, server)

[tim-salabim]

For this we'll need a dedicated leafpop::addPopupWidgets function. We already have leafpop:::addPopupIframe which might do the trick (not tested personally). If this is still of interest, please open an issue in leafpop as we've moved these functions there.