闪亮且绘图：在更大的模态窗口中重复使用绘图并控制字体大小

Question

我面临一个具体的挑战并提出了解决方案。我不确定这是否是一个优雅的解决方案。寻求改进。

挑战

我正在开发一个闪亮的应用程序，使用闪亮的仪表板，页面上有多个框。每个框可能包含一个绘图或 DT 表。我在每个框的页脚中提供了一个操作按钮，它允许打开一个模态对话框，显示更大版本的绘图。

我发现 Joe Cheng 的旧评论here展示了一种将相同的 renderPloty 输出链接到两个输出对象的方法。只要我在 UI 文件中调用一个对象并在 modalDialog 函数中调用另一个对象，就可以了。

但是，我想控制绘图中的各种字体大小：在大模态对话框中渲染的缩放绘图中，与绘图的“正常”渲染相比，我想使用更大的字体。我也不想冒险尝试 javascript 解决方案。

人们可以通过使用不同的字体大小复制 renderPlotly 函数来强迫自己解决这个问题。但我想重用现有的 renderPlotly 函数；就我而言，该函数相当冗长。

解决方案

• 创建一个函数，我称之为

  renderDynamic

  ，它接受字体大小列表作为参数
• 该函数返回一个

  renderPlotly

  对象

使用 iris 作为数据集：

renderDynamic <- function(pars = list(tick_font_size = 14, title_font_size = 18)) {   
  tick_font_size <- pars[[1]]
  title_font_size <- pars[[2]]

  return(
   renderPlotly({
     plot <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, 
                                type = 'scatter', mode = 'markers', 
                                color = ~Species, 
                                marker = list(size = 10, opacity = 0.7))) %>%
       layout(
         xaxis = list(
           tickfont = list(size = tick_font_size),
           titlefont = list(size = title_font_size)),
         yaxis = list(
           tickfont = list(size = tick_font_size),
           titlefont = list(size = title_font_size))
     plot
    })
   )
})

output$plot_normal <- renderDynamic(pars = list(tick_font_size = 15, title_font_size = 18, slider_font_size = 15))
output$plot_zoom <- renderDynamic(pars = list(tick_font_size = 22, title_font_size = 22, slider_font_size = 18))

想法？

Answer 1

我们可以修改现有的绘图对象，而无需通过

plotlyProxy()

重新渲染。在这种情况下，我们需要调用 relayout - 这比重新渲染整个小部件更快：

library(shiny)
library(plotly)

ui <- fluidPage(column(4, plotlyOutput("plot_normal")),
                actionButton("zoom", "zoom"))

server <- function(input, output, session) {
  # render plot once for both outputs
  output$plot_zoom <- output$plot_normal <- renderPlotly({
    plot <- plot_ly(
      data = iris,
      x = ~ Sepal.Length,
      y = ~ Sepal.Width,
      type = 'scatter',
      mode = 'markers',
      color = ~ Species,
      marker = list(size = 10, opacity = 0.7)
    ) %>% layout(
      xaxis = list(
        tickfont = list(size = 15),
        titlefont = list(size = 18)
      ),
      yaxis = list(
        tickfont = list(size = 15),
        titlefont = list(size = 18)
      )
    )
  })
  
  zoom_proxy <- plotlyProxy("plot_zoom", session)
  
  outputOptions(output, "plot_zoom", suspendWhenHidden = FALSE)
  
  observeEvent(input$zoom, {
    showModal(modalDialog(plotlyOutput("plot_zoom", height = "75vh"), size = "l", easyClose = TRUE))
    # modify plot shown in modalDialog
    plotlyProxyInvoke(zoom_proxy, "relayout", list(
      xaxis = list(
        tickfont = list(size = 22),
        titlefont = list(size = 22)
      ),
      yaxis = list(
        tickfont = list(size = 22),
        titlefont = list(size = 22)
      )
    ))
  })
}

shinyApp(ui, server)

旁注：您知道 bslib::card() 或 bs4Dash::box() 吗？两者都是可扩展的 - 但是，我不确定它们是否可以与 {shinydashboard} 一起使用。

PS：

library(DT)

中有一个等效的函数称为

dataTableProxy()

。