javascriptrshinyr-highcharterbslib

How to convert the plotly expandable sparkline example from the bslib docs to a Highcharter plot?


bslib has helpful documentation around their expandable sparklines. The documentation uses javascript to modify an existing plotly plot when a card is expanded. I'm trying to mimic the same behavior but for a highcharter plot instead of a plotly plot.

I want this to be in javascript, and not use shiny::getCurrentOutputInfo() as it creates a lag when expanding and minimizing the window.

I'd like the plot to have both x and y axes visible as well as the plot to be exportable when expanded and hide those elements when minimized. This is essentially the behavior I'd like to see using the getCurrentOutputInfo function (notice the lag and re-rendering of the plot).

Example App

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)

And this is the sample js code for reformating a plotly plot that I'd essentially like to mimic.

plotly javascript example

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

Solution

  • Using js, you could do it like this:

    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
                                    })
    
                                    chart.exporting.update({
                                      enabled: visible
                                    })
                                  });
                                  ro.observe(el);
                                }")
      })
      
      highchart_scatter <- function(x) {
        
        df2 <- df %>% 
          hchart('line', hcaes(x = dose, y = len))
    
        return(df2)
      }
    }
    
    shinyApp(ui, server)
    

    enter image description here