тл;др версия: Для многогранного сюжета мне нужен способ
В настоящее время я создаю приложение Shiny для выполнения базового исследовательского анализа различных наборов данных. Я использую ggplot2 вместе с plotly для создания гистограмм для различных факторов. Однако я столкнулся с проблемой, когда дело доходит до отображения длинных имен факторов на оси x. Я попытался повернуть метки, чтобы они лучше подходили, но сюжет, похоже, не выделяет для них достаточно вертикального пространства, из-за чего метки пересекаются с областью графика. Вот скриншот, чтобы лучше проиллюстрировать мою проблему:
Итак, мои вопросы:
Или, может быть, я задаю неправильный вопрос. Плохо ли вообще возиться с размерами графика вручную, и я должен просто попробовать что-то еще?
Кроме того, я заметил, что в некоторых случаях площадь сюжета становится довольно маленькой. Итак, вот бонусный вопрос: как я могу оценить размер, который потребуется всему графику, чтобы я мог динамически масштабировать общую высоту, чтобы ничего не обрезалось.
Ниже приведен минимальный рабочий пример с фиктивными данными из пакета synthpop
:
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)
Вот некоторые вещи, которые я пробовал/рассматривал:
renderPlot()
. Однако из-за этого графики в приложении выглядят размытыми, и у него есть собственные проблемы с масштабированием и перекрытием.plotlyOutput("hist_plot", height = "1000px")
. Это несколько решает проблему, когда я знаю, какой общий размер мне нужен, но также увеличивает размер области графика и меток. В идеале мы должны иметь возможность контролировать размер как общего размера диаграммы, так и графика независимо друг от друга.Обновлено: добавлен раздел tl:dr
Привет спасибо за подсказку! Я поиграл с решением @SBista, которое, я полагаю, было тем, что вы имели в виду. В моем случае это не очень помогает, потому что 1. Не позволяет изменять какие-либо размеры на графике и 2. Не позволяет проверить, сколько места «нужно» графику без какого-либо перекрытия.
Поскольку я не знаю, что еще есть в вашем приложении, я сомневаюсь, что это «одноразовый» ответ. После того, как вы прошли через это, дайте мне знать, что вы думаете, если это не работает для вас. Я уверен, что это не идеально. Для этого слишком много статического размера.
Несколько замечаний, относящихся к этому ответу
ggplot
в plotly
, оно сделало некоторые странные, но ожидаемые вещи.plotly.annotations
plotly.shapes
fixer()
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)
Ух ты! Я поражен, что вы действительно знаете все эти параметры для настройки макета графика на таком детальном уровне. Как вы сказали, это все еще не супер гибкое, но это рабочее решение, так что большое спасибо!
Посмотрите, приведет ли это вас туда, куда вы пытаетесь попасть: см. здесь. Если это не так, дайте мне знать. Я могу предоставить не только более подробную информацию, но и другие рабочие способы.