Search code examples
rshinyr-leaflet

Control the size of popupGraph() from leaflet in r shiny


I am having trouble setting my plot width to more than 300px in my popup of my leafletoutput.

The height can be set to whatever value, it will work, but it seems like the width is capped to 300px (the extra width will provide a greyed background).

Here's the example:

library(tidyverse)
library(ggplot2)
library(shiny)
library(leaflet)
library(leafpop)

id <- c(1,1,1,1,2,2,3,3,3,4)
lat <- c(49.823, 49.823, 49.823, 49.823, 58.478, 58.478, 57.478 , 57.478 , 57.478, 38.551)
lng <- c(-10.854, -10.854, -10.854, -10.854, -11.655, -11.655, 2.021 , 2.021 , 2.021, 5.256)
type <- c("A","C","B","B","C","A","B","A","C","B")
date <- c(152.5,307.5,145,481,152,109.5,258.5,107.5,186.5,150)
start <- c(123,235,135,192,149,101,205,75,155,100)
stop <- c(182,380,155,289,155,218,312,140,218,200)
myData <- data.frame(id,type,date,start,stop,lat,lng)


chronogramme<- function(dataId){

    dataFiltered<-filter(myData,id==dataId)
    
    p<- ggplot(dataFiltered,aes(type,date))+
        geom_linerange(aes(ymin=start,ymax=stop),size=5)+
        coord_flip()
    p
    return(p)
}

q = lapply(1:length(unique(myData$id)), function(i) {
  chronogramme(i)
})


ui <- fluidPage(
  leafletOutput("map", height = "100vh")
)


server <- function(input, output, session) {
  
  #Sortie map
  output$map <- renderLeaflet({
    leaflet()%>%
      addProviderTiles(providers$CartoDB.Positron) %>% 
      addCircleMarkers(
        data = myData,
        lat = myData$lat,
        lng = myData$lng,
        radius = 5,
        color = 'blue',
        stroke = FALSE,
        fillOpacity = 1,
        popup = popupGraph(q, width = 400, height = 300)
      )
  })

}

# Create Shiny app ----
shinyApp(ui = ui, server = server)

There is a similar question here concerning popupImage() but the solution doesn't work with popupGraph()...


Solution

  • popupOptions = popupOptions(maxWidth = 1000)
    

    this piece of code is the key to solve the pb, here is the full code :

    library(tidyverse)
    library(ggplot2)
    library(shiny)
    library(leaflet)
    library(leafpop)
    
    id <- c(1,1,1,1,2,2,3,3,3,4)
    lat <- c(49.823, 49.823, 49.823, 49.823, 58.478, 58.478, 57.478 , 57.478 , 57.478, 38.551)
    lng <- c(-10.854, -10.854, -10.854, -10.854, -11.655, -11.655, 2.021 , 2.021 , 2.021, 5.256)
    type <- c("A","C","B","B","C","A","B","A","C","B")
    date <- c(152.5,307.5,145,481,152,109.5,258.5,107.5,186.5,150)
    start <- c(123,235,135,192,149,101,205,75,155,100)
    stop <- c(182,380,155,289,155,218,312,140,218,200)
    myData <- data.frame(id,type,date,start,stop,lat,lng)
    
    
    chronogramme<- function(dataId){
    
        dataFiltered<-filter(myData,id==dataId)
    
        p<- ggplot(dataFiltered,aes(type,date))+
            geom_linerange(aes(ymin=start,ymax=stop),size=5)+
            coord_flip()
        p
        return(p)
    }
    
    q = lapply(1:length(unique(myData$id)), function(i) {
      chronogramme(i)
    })
    
    
    ui <- fluidPage(
      leafletOutput("map", height = "100vh")
    )
    
    
    server <- function(input, output, session) {
    
      #Sortie map
      output$map <- renderLeaflet({
        leaflet()%>%
          addProviderTiles(providers$CartoDB.Positron) %>% 
          addCircleMarkers(
            data = myData,
            lat = myData$lat,
            lng = myData$lng,
            radius = 5,
            color = 'blue',
            stroke = FALSE,
            fillOpacity = 1,
            popup = popupGraph(q, width = 400, height = 300),
            popupOptions = popupOptions(maxWidth = 1000)
          )
      })
    
    }
    
    # Create Shiny app ----
    shinyApp(ui = ui, server = server)