时间戳

首页 > 解决方案 > 添加一个箭头（位于绘图之外），它指向 x 轴并且是 R 中 ggarrange 绘图的一部分

r - 添加一个箭头（位于绘图之外），它指向 x 轴并且是 R 中 ggarrange 绘图的一部分

问题描述

我正在尝试制作一个箭头指向 x 轴（垂直于 x 轴）的图形，但我需要箭头位于绘图区域之外（指向 x 轴），并且我不知道如何使箭头出现，同时还允许情节很好地适合ggarrange组合多个相似情节的图中。这个图中发生了很多事情，所以我不确定是什么部分导致了问题。我正在使用ggarrange它，因为它允许我使绘图的轴对齐，并且我真的想要一个使绘图的轴保持对齐的解决方案。

这是我要创建的图（我在 PowerPoint 中添加了箭头）。 我想用 R 做什么

我正在使用这些包

library(tidyverse)
library(ggpubr)

这是我可重现的示例数据框。

df <- tribble(~month, ~temperature, ~temp.datetime, ~people, ~people.datetime,
             "march", "70", "2018-03-25 9:00", "2", "2018-03-25 9:12",
             "march", "79", "2018-03-26 10:00", "1", "2018-03-26 10:12", 
             "march", "77", "2018-03-26 11:10", "9", "2018-03-26 11:12",
             "march", "75", "2018-03-26 12:00", "4", "2018-03-26 12:12",
             "march", "72", "2018-03-27 13:30", "5", "2018-03-27 13:12",
             "march", "71", "2018-03-28 14:00", "1", "2018-03-28 14:12",
             "april", "69", "2018-04-24 22:00", "4", "2018-04-24 22:12",
             "april", "81", "2018-04-25 0:00", "0", "2018-04-25 0:12",
             "april", "73", "2018-04-25 12:00", "0", "2018-04-25 12:12",
             "april", "70", "2018-04-26 1:00", "3", "2018-04-26 1:12",
             "april", "72", "2018-04-26 2:20", "8", "2018-04-26 2:12",
             "april", "75", "2018-04-26 3:00", "4", "2018-04-26 3:12",
             "april", "77", "2018-04-27 4:00", "2", "2018-04-27 4:12",
             "april", "75", "2018-04-28 5:13", "2", "2018-04-28 5:12",
             "may", "70", "2018-05-24 15:00", "1", "2018-05-24 14:12",
             "may", "79", "2018-05-26 16:00", "6", "2018-05-26 15:12",
             "may", "79", "2018-05-26 16:45", "2", "2018-05-26 16:12",
             "may", "75", "2018-05-26 17:00", "7", "2018-05-26 17:12",
             "may", "72", "2018-05-27 18:00", "2", "2018-05-27 18:12",
             "july", "75", "2018-07-23 12:00", "1", "2018-07-23 12:12",
             "july", "77", "2018-07-24 13:00", "2", "2018-07-24 13:12",
             "july", "81", "2018-07-25 14:00", "5", "2018-07-25 14:12",
             "july", "72", "2018-07-26 15:00", "2", "2018-07-26 15:12",
             "july", "75", "2018-07-26 16:10", "0", "2018-07-26 16:12",
             "july", "77", "2018-07-26 17:00", "2", "2018-07-26 17:12",
             "july", "75", "2018-07-27 18:20", "1", "2018-07-27 18:12")

首先，我使所有数据都具有正确的结构。然后我根据月份将这个数据框分成 4 个子集（这对我的实际数据更有意义）。

df$temp.datetime <- as.POSIXct(df$temp.datetime)
df$people.datetime <- as.POSIXct(df$people.datetime)
df$temperature <- as.numeric(df$temperature)
df$people <- as.numeric(df$people)
df$month <- as.factor(df$month)
mar.df <- df %>% filter(month == "march")
apr.df <- df %>% filter(month == "april")
may.df <- df %>% filter(month == "may")
jul.df <- df %>% filter(month == "july")

然后，我为每个月的数据制作了相同的数字。它们有两个 y 轴，因为我正在绘制两组数据，它们的拍摄时间不同，所以虽然 x 轴对它们来说是相同的，但这些点并不完全对齐。“人”数据的 y 轴在所有 4 个月的图中都是相同的，因此可以轻松地将它们相互比较。

tempcolor <- "#EBC400"
peopcolor <- "#3b60e9"

mar.temp.peop.time <- ggplot(mar.df, aes())+
  geom_point(aes(x = people.datetime, y = people), fill = peopcolor, shape = 23, size = 3)+
  geom_point(aes(x = temp.datetime, y = temperature/10), fill = tempcolor, shape = 21, size = 3)+
  geom_line(aes(x = people.datetime, y = people), color = peopcolor)+
  geom_line(aes(x = temp.datetime, y = temperature/10), color = tempcolor)+
  scale_y_continuous(name = "Number of People in Room", limits = c(0, 10), sec.axis = sec_axis(trans = ~.*10, name = "Temperature of Room"))+
  xlab("Date")+
  theme_classic(base_size = 17)+
  theme(axis.title.y = element_text(color = peopcolor, face = "bold"), axis.title.y.right = element_text(color = tempcolor, face = "bold"))+
  theme(axis.title.x = element_blank())
mar.temp.peop.time

apr.temp.peop.time <- ggplot(apr.df, aes())+
  geom_point(aes(x = people.datetime, y = people), fill = peopcolor, shape = 23, size = 3)+
  geom_point(aes(x = temp.datetime, y = temperature/10), fill = tempcolor, shape = 21, size = 3)+
  geom_line(aes(x = people.datetime, y = people), color = peopcolor)+
  geom_line(aes(x = temp.datetime, y = temperature/10), color = tempcolor)+
  scale_y_continuous(name = "Number of People in Room", limits = c(0, 10), sec.axis = sec_axis(trans = ~.*10, name = "Temperature of Room"))+
  xlab("Date")+
  theme_classic(base_size = 17)+
  theme(axis.title.y = element_text(color = peopcolor, face = "bold"), axis.title.y.right = element_text(color = tempcolor, face = "bold"))+
  theme(axis.title.x = element_blank())
apr.temp.peop.time

may.temp.peop.time <- ggplot(may.df, aes())+
  geom_point(aes(x = people.datetime, y = people), fill = peopcolor, shape = 23, size = 3)+
  geom_point(aes(x = temp.datetime, y = temperature/10), fill = tempcolor, shape = 21, size = 3)+
  geom_line(aes(x = people.datetime, y = people), color = peopcolor)+
  geom_line(aes(x = temp.datetime, y = temperature/10), color = tempcolor)+
  scale_y_continuous(name = "Number of People in Room", limits = c(0, 10), sec.axis = sec_axis(trans = ~.*10, name = "Temperature of Room"))+
  xlab("Date")+
  theme_classic(base_size = 17)+
  theme(axis.title.y = element_text(color = peopcolor, face = "bold"), axis.title.y.right = element_text(color = tempcolor, face = "bold"))
may.temp.peop.time

jul.temp.peop.time <- ggplot(jul.df, aes())+
  geom_point(aes(x = people.datetime, y = people), fill = peopcolor, shape = 23, size = 3)+
  geom_point(aes(x = temp.datetime, y = temperature/10), fill = tempcolor, shape = 21, size = 3)+
  geom_line(aes(x = people.datetime, y = people), color = peopcolor)+
  geom_line(aes(x = temp.datetime, y = temperature/10), color = tempcolor)+
  scale_y_continuous(name = "Number of People in Room", limits = c(0, 10), sec.axis = sec_axis(trans = ~.*10, name = "Temperature of Room"))+
  xlab("Date")+
  theme_classic(base_size = 17)+
  theme(axis.title.y = element_text(color = peopcolor, face = "bold"), axis.title.y.right = element_text(color = tempcolor, face = "bold"))
jul.temp.peop.time

然后，我曾经ggarrange将 4 个图合并为一个，轴对齐。

eachmonth <- ggarrange(
  mar.temp.peop.time, apr.temp.peop.time, may.temp.peop.time, jul.temp.peop.time,
  ncol = 2, nrow = 2,
  labels = c("A", "B", "C", "D"),
  label.x = .03, font.label = list(size = 25), 
  align = "v", heights = c(5,5,5,5)
)
eachmonth

如果箭头避开 x 轴上的标签会非常好，因为我想要放置箭头的位置（它标记了一个特定的时间点）实际上与日期刻度标签之一有一点重叠。此外，如果此代码的任何部分可以清理或以不同方式完成，请告诉我！我还在学习。

我试过在这个网站上寻找答案，但似乎没有一个正是我想要的。这似乎接近解决方案，但我无法显示箭头（即使在 之前的情节上ggarrange）。我也尝试过annotate()如下使用，但同样，我无法显示箭头。

annotate(geom = "segment", x = as.POSIXct("2018-07-24 12:30"), y = 0, xend = as.POSIXct("2018-07-24 12:30"), yend = -3.8, arrow = arrow(length = unit(2, "mm")), color = "red")

标签： rdatetimeggplot2

解决方案

也许这符合您的需求。

  1. ggpubr::ggarrange我没有使用，而是使用了，patchwork因为它在对齐绘图方面做得很好，而且还可以通过patchwork::wrap_plots().

  2. 您可以通过 eg 将数据拆分为列表来简化代码，split()并使用 eg 将绘图代码应用于每个列表元素lapply。为此，我使用了包含您的绘图代码的辅助函数。注意：要设置正确的顺序，我使用forcats::fct_inorder

  3. 即使使用单个图也不会出现红色箭头的问题与您设置 y 比例的限制有关，该限制c(0, 10)具有删除所有不符合限制范围的数据的副作用，即你的红色箭头从 开始被丢弃-3.8。这可以通过设置限制来避免coord_cartesian。此外，我设置clip=off了坐标以避免在到达绘图边缘时箭头被剪掉。

  4. 要切换箭头的方向，只需切换y和yend。annotate

  5. 对于刻度标签过度绘制的问题，我建议像我一样减小基本字体大小。

library(tibble)
library(ggplot2)
library(patchwork)

df$month <- forcats::fct_inorder(df$month)

df_list <- split(df, df$month)

tempcolor <- "#EBC400"
peopcolor <- "#3b60e9"

plot_fun <- function(x) {
  ggplot(x, aes())+
    geom_point(aes(x = people.datetime, y = people), fill = peopcolor, shape = 23, size = 3)+
    geom_point(aes(x = temp.datetime, y = temperature/10), fill = tempcolor, shape = 21, size = 3)+
    geom_line(aes(x = people.datetime, y = people), color = peopcolor)+
    geom_line(aes(x = temp.datetime, y = temperature/10), color = tempcolor)+
    scale_y_continuous(name = "Number of People in Room", sec.axis = sec_axis(trans = ~.*10, name = "Temperature of Room"), expand = c(0, 0)) +
    coord_cartesian(ylim = c(0, 10), clip = "off") +
    xlab("Date")+
    theme_classic(base_size = 10)+
    theme(axis.title.y = element_text(color = peopcolor, face = "bold"), axis.title.y.right = element_text(color = tempcolor, face = "bold"),
          axis.title.x = element_blank())
}

plots <- lapply(df_list, plot_fun)

plots[["july"]] <- plots[["july"]] + annotate(geom = "segment", x = as.POSIXct("2018-07-24 12:30"), 
                      y = -3.8, xend = as.POSIXct("2018-07-24 12:30"), yend = 0, 
                      arrow = arrow(length = unit(2, "mm")), color = "red")

eachmonth <- wrap_plots(plots) & plot_annotation(tag_levels = "A") 

eachmonth

推荐阅读