Невозможно добавить легенду в мультиграфик коровьего графика

Я создал карту, на которой каждый квартал имеет свою гистограмму. Гистограммы имеют общую легенду, поэтому я бы хотел, чтобы легенда располагалась горизонтально под картой, что я пытался сделать с помощью get_legend, но продолжал получать предупреждение, а легенда не отображалась.

In get_plot_component(plot, "guide-box") :
 Multiple components found; returning the first one. To return all, use `return_all = TRUE`.'

Поэтому я предоставляю исходный код, надеясь, что кто-нибудь подскажет мне, как создать желаемый сюжет. Кроме того, если у кого-нибудь есть советы о том, как сохранить окончательный объект без изменения положения каждого подграфика по сравнению с тем, как он выглядит, если я открою график в новом окне из R с помощью «масштабирования», это тоже будет полезно. Мне всегда приходится экспериментировать с шириной и высотой, чтобы воспроизвести это.

Вот как карта выглядит сейчас в масштабе:

Вот код для его создания. Я не могу предоставить исходный объект, потому что dput() будет очень длинным:

# Reshape the data from wide to long format
quarts_long <- tidyr::pivot_longer(quarts, cols = c("Mammals", "Birds", "Amphibians", "Reptiles"), names_to = "Class", values_to = "Count")

# Calculate centroids of each quarter
quarts_centroids <- st_centroid(quarts)

# Create histograms for each quarter
hist_plots <- list()
for (i in 1:nrow(quarts)) {
  hist_plots[[i]] <- ggplot(quarts_long[quarts_long$Quarter == quarts$Quarter[i],]) +
    geom_col(aes(x = Class, y = Count, fill = Class)) +  
    scale_y_continuous(limits = c(0, 300), breaks = c(0, 150, 300)) +
    labs(y = "", x = "") +  # Remove axis labels
    theme_void() +  # Use minimal theme
    theme(axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0)),  # Adjust y-axis label position
          axis.text.x = element_blank(),  # Remove x-axis text
          axis.text.y = element_text(size = 10),
          legend.position = "none")  # Adjust y-axis text size
}

# Create the quarters map
map_plot <- ggplot() +
  geom_sf(data = quarts, fill = alpha("white", 0)) +
  labs(x = NULL, y = NULL) +
  theme_void() +
  theme(legend.position = "none")  # Move legend to bottom

# Define shared legend
shared_legend <- get_legend(hist_plots[[1]])

# Draw the final plot with legend
p <- ggdraw() +
  draw_plot(hist_plots[[1]], 0.48, 0.63, 0.17, 0.15) +  # Draw the northeast
  draw_plot(hist_plots[[2]], 0.28, 0.63, 0.17, 0.15) +  # Draw the northwest
  draw_plot(hist_plots[[3]], 0.48, 0.38, 0.17, 0.15) +  # Draw the southeast
  draw_plot(hist_plots[[4]], 0.28, 0.38, 0.17, 0.15) +  # Draw the southwest
  draw_plot(map_plot, 0.05, 0.05, 0.95, 0.95)  + # Draw the quarters map
  draw_plot(shared_legend, 0.2, 0.05, 0.6, 0.1)

Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
1
0
259
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

У вас есть как минимум одна, а возможно и две проблемы. Для начала вот более простой репрекс, который создает ту же проблему:

library(ggplot2)
library(cowplot)

p <- ggplot(mpg, aes(cty, hwy)) +
  geom_point(aes(color = drv)) +
  theme(legend.position = "none")

shared_legend <- get_legend(p)
#> Warning in get_plot_component(plot, "guide-box"): Multiple components found;
#> returning the first one. To return all, use `return_all = TRUE`.

ggdraw() +
  draw_plot(p, x = 0, width = .45) +
  draw_plot(p, x = .45, width = .45) +
  draw_plot(shared_legend, x = .85, width = .2)

1. Не удаляйте легенду, пока не получите ее.

Ваша первая проблема в том, что вы указываете legend.position = "none" в theme(). При этом легенда будет удалена, и get_legend() не будет легенды, которую можно было бы «получить». Вместо этого удалите legend.position = "none" из исходной спецификации сюжета, а затем добавьте его после получения легенды:

library(ggplot2)
library(cowplot)

p <- ggplot(mpg, aes(cty, hwy)) +
  geom_point(aes(color = drv))

shared_legend <- get_legend(p)
#> Warning in get_plot_component(plot, "guide-box"): Multiple components found;
#> returning the first one. To return all, use `return_all = TRUE`.

p <- p + theme(legend.position = "none")

ggdraw() +
  draw_plot(p, x = 0, width = .45) +
  draw_plot(p, x = .45, width = .45) +
  draw_plot(shared_legend, x = .85, width = .2)

2. Избегайте ошибки get_legend()

Это решит проблему, пока legend.position = "right", который используется по умолчанию. Но в противном случае get_legend() не вернет легенду, а это известная проблема.

В качестве обходного пути вы можете использовать get_plot_component(plot, "guide-box", return_all = TRUE). Вам нужно будет проверить это, чтобы увидеть, в каком положении находится легенда, и соответствующим образом индексировать результат. например, для legend.position = "bottom":

p <- ggplot(mpg, aes(cty, hwy)) +
  geom_point(aes(color = drv)) +
  theme(legend.position = "bottom")

# when position = "bottom," legend is the third grob in the list
shared_legend <- cowplot::get_plot_component(p, "guide-box", return_all = TRUE)[[3]]

p <- p + theme(legend.position = "none")

ggdraw() +
  draw_plot(p, x = 0, y = .1, width = .5, height = .9) +
  draw_plot(p, x = .5, y = .1, width = .5, height = .9) +
  draw_plot(shared_legend, x = 0, y = 0, height = .2)

Created on 2024-04-11 with reprex v2.1.0

Другие вопросы по теме