调整Shiny应用程序中ggplot2和plotly中旋转的x轴标签的垂直间距

huangapple go评论81阅读模式
英文:

Adjusting vertical space for rotated x-axis labels in ggplot2 and plotly for a Shiny app

问题

简要版本:
为 faceted plotly,我需要一种方式:

  1. 估计 plotly 图表元素(图区、标签)的相对大小
  2. 操作 plotly 中为不同元素分配的相对空间
  3. 基于标准,如最小 plot 区域大小,定义 plotly 的绝对大小

我正在构建一个 Shiny 应用,用于对各种数据集进行基本的探索性数据分析。我使用 ggplot2 与 plotly 创建不同因素的直方图。然而,当显示较长的因素名称时,我遇到了问题。我尝试旋转标签以使其更好地适应,但 plotly 似乎没有为它们分配足够的垂直空间,导致标签与图区相交。这是一个截图以更好地说明我的问题:

Screenshot

所以我的问题是:

  1. 如何调整标签的垂直空间?
  2. 如何根据最长因素名称的长度动态进行调整?

或者也许我问错了问题。手动干预图的尺寸是个坏主意吗?我应该尝试其他方法吗?

此外,我注意到在某些情况下,图区变得非常小。
因此,这里有一个额外的问题:如何估算整个图需要的尺寸,以便我可以动态地调整总高度,以便不会裁切任何内容。

以下是一个使用 synthpop 包中的虚拟数据的最小工作示例:...

我尝试/考虑过的一些事情:

  • 不使用 plotly,而只是坚持使用 ggplot2 并使用 renderPlot()。然而,这使得应用中的图表看起来模糊,而且它有自己的缩放和重叠问题。
  • 更改标签旋转并通过增加默认应用宽度来允许更多的水平空间。然而,在我这种情况下,我需要能够使用 Rstudio 中的“运行应用”按钮运行应用,这不允许更改默认大小,参见此处
  • 手动调整图的高度,例如,使用 plotlyOutput("hist_plot", height = "1000px")。当我知道需要的总尺寸时,这在某种程度上解决了问题,但它也会增加图区和标签的大小。理想情况下,我们应该能够独立控制整体图表大小和图的大小。
  • 我考虑了这篇优秀指南中解释的一切,但在我这种情况下都不适用。
英文:

tl;dr version:
For a faceted plotly, I need a way to

  1. Estimate the relative size of plotly chart elements (plot area, labels)
  2. Manipulate the relative space allowed for the different elements in the plotly
  3. Based on a criterion, e.g. minimum plot area size, define an absolute size of the plotly.

I am currently building a Shiny app for performing basic exploratory data analysis on various datasets. I'm using ggplot2 along with plotly to create histograms for different factors. However, I'm facing an issue when it comes to displaying long factor names on the x-axis. I tried rotating the labels to make them fit better, but plotly doesn't seem to allocate enough vertical space for them, causing the labels to intersect with the plot area. Here's a screenshot to better illustrate my problem:

Screenshot

So my questions are:

  1. How can I adjust the vertical space for the labels?
  2. How can I do this dynamically, depending on the length of the longest factor name?

Or maybe I am asking the wrong question. Is it a bad idea to mess with plot dimensions manually altogether and should I just try something else?

Additionally, I noticed that the plot area becomes quite small in certain cases.
So here is a bonus question: How can I estimate the size the entire plot would need, so I can scale the total height dynamically, so that nothing gets cut off.

Below is a minimal working example with dummy data from the synthpop package:

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)

ui <- fluidPage(
    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())
    })
}
shinyApp(ui = ui, server = server)

Here are some things I tried/considered:

  • Not using plotly, but just sticking with ggplot2 and use renderPlot(). This, however, makes the plots appear blurry in the app and it has it own scaling and overlapping problems.
  • changing the label rotation and allowing for more horizontal space by increasing the default app width. However, with the use case I have, I need to be able to run the app with the run app button in Rstudio, and this does not allow changing the default size, see here
  • manually adjusting the height of the plot, e.g. with plotlyOutput("hist_plot", height = "1000px"). This somewhat solves the problem when I know what total size I need, but it also increases both the size of the plot area and for the labels. Ideally, we should be able to control the size of both the overall chart size and the plot independently of each other.
  • I considered everything that is explained in this great guide here, but none of it is applicable in my case.

Edit: added tl:dr section

答案1

得分: 0

由于我不知道你的应用中还有什么内容,我怀疑这不是一个“一次性”回答。在你浏览完后,如果对你不起作用,请告诉我你的想法。我确信这不是完美的。有太多静态大小,以至于这种情况不可能发生。

有几件事情要注意,与这个答案有关:

  • 当你将这从ggplot转换到plotly时,它做了一些奇怪但是预料之中的事情。
  • facet标签是plotly.annotations
  • facet标签框是plotly.shapes
  • 单独的图在y轴域的两端设置
    • 默认情况下,每个轴的域为[0, 1](你可以更改它,但为什么?)
    • 将底部行的图放在域的底部,你的标签将永远不会容易处理。

这是我所做的

在样式方面
  • 我为x轴标签添加了按比例缩放的文本大小(基于屏幕大小)
  • 我没有为facet标签、y轴标签或轴标题添加按比例缩放的文本大小
  • 我更改了图的高度以使其动态变化(基于屏幕高度)
fixer()函数中
  • 捕获了图的顶部在y轴域中的位置
  • 修改了所有与底部图位置有关或相关的特征的位置
    • 形状的yanchor
    • 注释的y位置
    • ‘底部’行图的单独域位置
代码

大部分代码与你问题中的代码没有变化。在代码中寻找我的评论以注意到变化。如果你有问题,我只是一条评论的距离。

库(整洁)
库(绘图)
库(合成流行)# 用于示例数据

# 生成示例数据框
数据< -合成流行::SD2011 |选择(一切)|切片(1:6)

修复程序< -函数(pt){ # &lt;---我添加了
  rg < - pt $ x $ layout $ yaxis2 $ domain [2] #基于域的图形大小
  lapply(1:length(pt $ x $ layout $ shapes),function(i){ #修改形状
    if(isTRUE(pt $ x $ layout $ shapes [[i]] $ yanchor == rg)){ #用于错误的isTRUE
      pt $ x $ layout $ shapes [[i]] $ yanchor << -2.5 * rg #将灰色正方形向上移动
    }
  })
  lapply(1:length(pt $ x $ layout $ annotations),function(j){ #修改注释
    if(isTRUE(round(pt $ x $ layout $ annotations [[j]] $ y,6)== round(rg,6))){ ##用于错误的isTRUE
      pt $ x $ layout $ annotations [[j]] $ y << -2.5 * rg #将facet标签向上移动
    }
  })
  pt $ x $ layout $ yaxis2 $ domain << -c(1.5 * rg,2.5 * rg) #修改图的位置
  pt
}

ui < -fluidPage(
  tags $ head(# &lt;---我添加了
    tags $ style(HTML(#动态x轴标签的大小;动态绘图高度
      “.xaxislayer-above text{
        font-size: calc(6px + 6 * ((100vw - 300px) / (1600 - 300))) !important;
      }
      #hist_plot{
        height: 75vh !important;
      }”))
  ),
  sidebarLayout(
    sidebarPanel(),
    mainPanel(
      plotlyOutput(“hist_plot”)
    )
  )
)

服务器< -函数(输入,输出){
  hist_plot < -reactive({
    数据| > pivot_longer(cols = everything(),names_to = “key”,values_to = “value”)| > ggplot(aes(x = value))+
      geom_bar() +
      facet_wrap(~key,nrow = 2,scales = “free_x”)+
      主题(
        axis.text.x = element_text(angle = 90))
  }
  )

  输出$hist_plot < -renderPlotly({
    req(hist_plot)
    ggplotly(hist_plot()) %>%
      layout(margin = list(b = 100)) %>%
      fixer() # &lt;---我添加了
  })
}
shinyApp(ui = ui,server = server)

调整Shiny应用程序中ggplot2和plotly中旋转的x轴标签的垂直间距

英文:

Since I don't know what else is in your app, I doubt this is a 'one shot' answer. After you've gone through it, let me know what you're thinking, if it's not working out for you. I am certain this is not perfect. There is too much static sizing for that to happen.

A few things to note, relevant to this answer

  • When you took this from ggplot to plotly it did some hokey, yet expected, things
  • facet labels are plotly.annotations
  • facet label boxes are plotly.shapes
  • individual plots are set at opposing ends of the y-axis domain
    • Each axis, by default has a domain of [0, 1] (you could change it, but why??)
    • With the bottom row of plots at the bottom of the domain, your labels were never going to be easily addressed...

This is what I did

In styling
  • I added scaled text sizing to the x-axis labels (based on viewscreen size)
  • I did not add scaled text sizing to the facet labels, y-axis labels, or the axis titles
  • I changed the plot height to be dynamic (based on viewscreen height)
In the fixer() function
  • captured the top of the plots' position in the y-axis domain
  • modified the positions of all features controlled or relevant to the bottom plots' positions
    • the shapes yanchor
    • the annotations y position
    • the individual domain positions for 'bottom' row plots
The code

Most of the code is not changed from the code in your question. Look for my comments in the code to note the changes. If you have questions, I'm but a comment away.

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

# generate example data frame
data &lt;- synthpop::SD2011 |&gt;
  select(where(is.factor)) |&gt;
  slice(1:6)

fixer &lt;- function(pt) {                              # &lt;--- I added
  rg &lt;- 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 &lt;&lt;- 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 &lt;&lt;- 2.5 * rg              # move facet labels up
    }
  })
  pt$x$layout$yaxis2$domain &lt;- c(1.5 * rg, 2.5 * rg)          # modify plot positions
  pt
}

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

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

调整Shiny应用程序中ggplot2和plotly中旋转的x轴标签的垂直间距

huangapple
  • 本文由 发表于 2023年4月19日 15:00:32
  • 转载请务必保留本文链接:https://go.coder-hub.com/76051568.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定