Настройка вертикального пространства для повернутых меток оси x в ggplot2 и plotly для приложения Shiny

Поскольку я не знаю, что еще есть в вашем приложении, я сомневаюсь, что это «одноразовый» ответ. После того, как вы прошли через это, дайте мне знать, что вы думаете, если это не работает для вас. Я уверен, что это не идеально. Для этого слишком много статического размера.

Несколько замечаний, относящихся к этому ответу

• Когда вы перенесли это из ggplot в plotly, оно сделало некоторые странные, но ожидаемые вещи.
• этикетки на гранях plotly.annotations
• коробки с фасетными этикетками plotly.shapes
• отдельные графики установлены на противоположных концах домена оси Y
  • Каждая ось по умолчанию имеет домен [0, 1] (вы могли бы изменить его, но зачем??)
  • С нижним рядом графиков в нижней части домена ваши метки никогда не будут легко адресованы...

Это то, что я сделал

В стиле

• Я добавил масштабированный размер текста к меткам по оси x (в зависимости от размера экрана).
• Я не добавлял масштабированный размер текста к меткам фасетов, меткам оси Y или заголовкам осей.
• Я изменил высоту графика, чтобы она была динамической (в зависимости от высоты экрана)

В функции fixer()

• захватил верхнюю часть графика в области оси Y
• изменены положения всех объектов, контролируемых или относящихся к позициям нижних графиков
  • формы yanchor
  • положение аннотаций y
  • позиции отдельных доменов для «нижних» рядов графиков

Код

Большая часть кода не отличается от кода в вашем вопросе. Ищите мои комментарии в коде, чтобы отметить изменения. Если у вас есть вопросы, я всего лишь комментарий.

library(shiny)
library(tidyverse)
library(plotly)
library(synthpop) # for example data

# generate example data frame
data <- synthpop::SD2011 |>
  select(where(is.factor)) |>
  slice(1:6)

fixer <- function(pt) {                              # <--- I added
  rg <- pt$x$layout$yaxis2$domain[2]                           # graph size based on domain
  lapply(1:length(pt$x$layout$shapes), function(i) {           # modify shapes
    if (isTRUE(pt$x$layout$shapes[[i]]$yanchor == rg)) {        # isTRUE for errors
      pt$x$layout$shapes[[i]]$yanchor <<- 2.5 * rg             # move grey squares up
    }
  })
  lapply(1:length(pt$x$layout$annotations), function(j) {      # modify annotations
    if (isTRUE(round(pt$x$layout$annotations[[j]]$y, 6) == round(rg, 6))) { ## isTRUE for errors
      pt$x$layout$annotations[[j]]$y <<- 2.5 * rg              # move facet labels up
    }
  })
  pt$x$layout$yaxis2$domain <- c(1.5 * rg, 2.5 * rg)          # modify plot positions
  pt
}

ui <- fluidPage(
  tags$head(                                        # <--- I added
    tags$style(HTML(  # dynamic x-axis labels' size; dynamic plot height
      ".xaxislayer-above text{
        font-size: calc(6px + 6 * ((100vw - 300px) / (1600 - 300))) !important;
      }
      #hist_plot{
        height: 75vh !important;
      }"))
  ),
  sidebarLayout(
    sidebarPanel(),
    mainPanel(
      plotlyOutput("hist_plot")
    )
  )
)

server <- function(input, output) {
  hist_plot <- reactive({
    data |>
      pivot_longer(cols=everything(), names_to = "key", values_to = "value") |>
      ggplot(aes(x=value)) +
      geom_bar() +
      facet_wrap(~key, nrow = 2, scales = "free_x") +
      theme(
        axis.text.x = element_text(angle = 90))
  })
  
  output$hist_plot <- renderPlotly({
    req(hist_plot)
    ggplotly(hist_plot()) %>% 
      layout(margin = list(b = 100)) %>% fixer()        # <--- I added
  })
}
shinyApp(ui = ui, server = server)