在rshiny中控制传单中popupGraph()的大小

Question

我在传单输出的弹出窗口中将绘图宽度设置为超过 300 像素时遇到问题。

高度可以设置为任何值，它会起作用，但似乎宽度上限为300px（额外的宽度将提供灰色背景）。

示例如下：

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)

有一个类似的问题here关于popupImage()，但该解决方案不适用于popupGraph()...

Answer 1

popupOptions = popupOptions(maxWidth = 1000)

这段代码是解决pb的关键，完整代码如下：

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)