使用 javascript 将 Plotly Expandable Sparkline 转换为 bslib 卡中的 HighCharter Plot

Question

bslib

有关于其可扩展迷你图 的有用文档。该文档使用 javascript 在卡片展开时修改现有的绘图。我试图模仿相同的行为，但对于 highcharter 情节而不是情节情节。

我希望这是在 JavaScript 中，而不是使用

shiny::getCurrentOutputInfo()

，因为它在扩展和最小化窗口时会产生 lag。

我希望绘图的 x 轴和 y 轴都可见，并且绘图在展开时可导出，并在最小化时隐藏这些元素。这本质上是我希望使用

getCurrentOutputInfo

函数看到的行为（注意绘图的滞后和重新渲染）。

示例应用程序

library(shiny)
library(bslib)
library(highcharter)

ui <- page_fluid(
    value_box(
      title = "Test",
      value = "Test",
      showcase = highchartOutput("hcp"),
      showcase_layout = showcase_top_right(),
      full_screen = TRUE,
      theme = "success"
  )
)

server <- function(input, output) {
  
  df <- data.frame(dose=c("D0.5", "D1", "D2"),
                   len=c(4.2, 10, 29.5))
  
  output$hcp <- renderHighchart({
    highchart_scatter()
  })
  
  highchart_scatter <- function(x) {
    info <- getCurrentOutputInfo()
    large <- isTRUE(info$height() > 200)
    
    df2 <- df %>% 
      hchart('line', hcaes(x = dose, y = len))
    
    if(large){
      df2 <- df2 %>%
        hc_exporting(enabled = TRUE)
    } else {
      df2 <- df2 %>%
        hc_xAxis(visible = FALSE) %>% 
        hc_yAxis(visible = FALSE)
    }
    return(df2)
  }
}

shinyApp(ui, server)

这是用于重新格式化我本质上想模仿的情节图的示例 js 代码。

plotly javascript 示例

  htmlwidgets::onRender(
    "function(el) {
      var ro = new ResizeObserver(function() {
         var visible = el.offsetHeight > 200;
         Plotly.relayout(el, {'xaxis.visible': visible});
      });
      ro.observe(el);
    }"
  )

Answer 1

使用

js

，你可以这样做：

library(shiny)
library(bslib)
library(highcharter)

ui <- page_fluid(
  value_box(
    title = "Test",
    value = "Test",
    showcase = highchartOutput("hcp"),
    showcase_layout = showcase_top_right(),
    full_screen = TRUE,
    theme = "success"
  )
)

server <- function(input, output) {
  
  df <- data.frame(dose=c("D0.5", "D1", "D2"),
                   len=c(4.2, 10, 29.5))
  
  output$hcp <- renderHighchart({
    highchart_scatter() |> 
      htmlwidgets::onRender("function(el, x) {
                              var ro = new ResizeObserver(function() {
                                var visible = el.offsetHeight > 200;
                                var chart = $('#' + el.id).highcharts()
                              
                                chart.xAxis[0].update({
                                  visible: visible
                                })
                              
                                chart.yAxis[0].update({
                                  visible: visible
                                })
                              });
                              ro.observe(el);
                            }")
  })
  
  highchart_scatter <- function(x) {
    
    df2 <- df %>% 
      hchart('line', hcaes(x = dose, y = len))

    return(df2)
  }
}

shinyApp(ui, server)