Adjust number of discrete axis breaks based on window width in Shiny with ggplotly

Question

I have a dashboard that have a number of graphs (created in ggplot then converted into plotly plots with ggplotly() arranged in columns of two within fluidRows():

However, when the browser window is minimised, the bar sizes adjust automatically, but the x-axis labels become squashed together:

How can I dynamically adjust the number of x-axis breaks based on browser window width? I know I can get the dimensions of the browser window using code from this question, and I had the idea of creating a reactive value based on the window width that I could then pass to breaks in scale_x_discrete(), but I haven't been able to bring the entire thing together.

I need a solution that will work regardless of what discrete values are on the x-axis, since I have about ~20 different graphs with different values, e.g. some may be be 'Level1 - Level10', others may be different codes, e.g. AEF01 - AEF10.

Reproducible code:

library(shiny)
library(plotly)
library(tidyverse)

dat <- data.frame(
  x = factor(rep(paste0("Level", 1:10)), 
             levels = c("Level1", "Level2", "Level3", "Level4", "Level5", "Level6",
                        "Level7", "Level8", "Level9", "Level10")),
  y = rep(runif(10, 20, 100))
)


ui <- fluidPage(

    fluidRow(
      column(
        width = 6,
        plotlyOutput("plot")
      )
    )
)


server <- function(input, output) {
  output$plot <- renderPlotly({
    plot <- dat %>% 
      ggplot(aes(x = x, y = y, fill = y)) +
      geom_bar(stat = "identity", position = "dodge") 
    
    ggplotly(plot)
    
  })
}

I'd [rotate the labels](https://stackoverflow.com/questions/39116470/rotate-labels-using-plotly-in-r). — ismirsehregal, Aug 29 '22 at 08:39
I am aware of that. So I posted a comment and not an answer. — ismirsehregal, Aug 29 '22 at 09:27

score 1 · Answer 1 · answered Aug 29 '22 at 14:01

The example below shows a possible route. I created some JS functions to calculate % of overlap between the labels (you could also decide just to use the screen resolution for an easier approach) and pass that on to shiny.

The difficult part however, remains of how to translate this signal to a meaningful selection of breaks. I showed one solution, but it is not the most elegant one. Here, you need to define your own logic. But the example shows at least how to

Create a plot specific trigger which can be read by shiny: <plot_id>_overlap
Us this trigger to so something in the renderPlot function.

library(shiny)
library(plotly)
library(tidyverse)

dat <- data.frame(
  x = factor(rep(paste0("Level", 1:10)), 
             levels = c("Level1", "Level2", "Level3", "Level4", "Level5", "Level6",
                        "Level7", "Level8", "Level9", "Level10")),
  y = rep(runif(10, 20, 100))
)

ovlp_script <- HTML("function overlap_pct(a, b) {
   let dim_a = a.getBoundingClientRect();
   let dim_b = b.getBoundingClientRect();
   return Math.max(dim_a.x + dim_a.width - dim_b.x, 0) / (dim_b.x + dim_b.width);
}

function check_overlap(id) {
   let ticks = $('#' + id + ' .xtick text').toArray();
   let res = {sum_overlap: 0,
              elem: ticks[0]};
   ticks.shift();
   res = ticks.reduce(function(a, b) {
      return {sum_overlap: a.sum_overlap + overlap_pct(a.elem, b),
              elem: b};
   }, res);
   return res['sum_overlap'];
}
")

resize_listener <- HTML("var resizeId;
   function notify_resize() {
      $('.js-plotly-plot').each(function(idx, e) {
         let ovlp = check_overlap(e.id);
         Shiny.setInputValue(e.id + '_overlap', ovlp, {priority: 'event'});
      });
   }   
   
   $(window).resize(function() {
      clearTimeout(resizeId);
      resizeId = setTimeout(notify_resize, 750);
   });
")


ui <- fluidPage(
  tags$head(tags$script(ovlp_script, resize_listener)),
  fluidRow(
    column(
      width = 6,
      plotlyOutput("plot")
    )
  )
)


server <- function(input, output) {
  output$plot <- renderPlotly({
    overlap <- input$plot_overlap
    ## ToDo: find a smarter way of how to translate overlap % into selection of levels
    overlap <- if (is.null(overlap)) 0 else 4 * overlap
    nl <- levels(dat$x)
    step_size <- length(nl) / floor(length(nl) * (1 - overlap))
    sel <- unique(round(seq(1L, length(nl), step_size)))
    plot <- dat %>% 
      ggplot(aes(x = x, y = y, fill = y)) +
      geom_bar(stat = "identity", position = "dodge") +
      scale_x_discrete(breaks = nl[sel])

    ggplotly(plot)
    
  })
}

shinyApp(ui, server)

Adjust number of discrete axis breaks based on window width in Shiny with ggplotly

1 Answers1