R语言 如何生成具有不同条形宽度的时间轴?

acruukt9  于 2023-07-31  发布在  其他
关注(0)|答案(3)|浏览(94)

我想绘制一个如下所示的时间轴,但条的宽度会根据特定变量的值(在本例中为n)而变化。
你知道有什么方便的方法吗?
当前的时间轴是通过vistime包绘制的,其中linewidth参数的长度必须为1。例如,理想情况下,它将接受df$n*3
代码如下:

library(lubridate)
library(vistime)

df <- data.frame(debut = c(rep(2010,3), rep(2011,2), 2012),
                 fin = c(2011,2012,2013,2012,2013,2013),
                 n = c(3,1,2,6,7,5),
                 event = paste("n =", c(3,1,2,6,7,5), sep=" "),
                 color = c("#D73027", "#F46D43", "#FDAE61", "#FEE08B", "#D9EF8B", "#A6D96A"))
df$debut <- ymd(df$debut, truncated = 2L)
df$fin <- ymd(df$fin, truncated = 2L)

vistime(df, col.event="event", col.start = "debut", col.end = "fin", optimize_y = F, linewidth = 20, col.color = "color")

字符串
谢谢你帮忙!
输出:
x1c 0d1x的数据

g0czyy6m

g0czyy6m1#

或多或少与@AllanCameron的答案相同,但使用他(和@teunbrand)的geomtextpath包通过一个geom添加片段和标签,此外还提供了一种方便的方法来居中标签:

library(ggplot2)
library(geomtextpath)

df$id <- seq(nrow(df))

ggplot(df) +
  geom_textsegment(
    aes(
      x = debut, xend = fin, y = id, yend = id,
      label = event, linewidth = n, color = color
    ),
    textcolour = "black", 
    gap = FALSE,
    show.legend = FALSE
  ) +
  scale_color_identity() +
  scale_y_reverse() +
  scale_linewidth_continuous(range = c(5, 10)) +
  guides(linewidth = "none") +
  theme_bw() +
  theme(
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank()
  ) +
  labs(x = NULL, y = NULL)

字符串
x1c 0d1x的数据
此外,它还提供了很多选项来设置标签的样式,例如:有一个gap参数来“断开”标签的段:

geom_textsegment(
    aes(
      x = debut, xend = fin, y = id, yend = id,
      label = event, linewidth = n, color = color
    ),
    textcolour = "black", 
    gap = TRUE,
    show.legend = FALSE
 )


j5fpnvbx

j5fpnvbx2#

这个看起来会好些。

df <- df[nrow(df):1, ]  ## reverse df
s <- sapply(df[1:2], \(x) as.Date(paste(x, '0101'), '%Y %m %d'))  ## convert columns to numeric date
ds <- do.call('seq.Date', c(as.list(as.Date(range(s))), '6 months'))  ## get dates for x-axis
hlfw <- (df$n) + 1  ## get half-widths of the bars
ys <- (cumsum(hlfw*2) - hlfw) + seq_along(hlfw)  ## get y values
plot.new(); plot.window(range(s), c(0, max(ys + hlfw))); box()  ## plot the thing ...
abline(v=ds, col=8, lty=3)
clr <- rainbow(length(hlfw), .7, .85, end=c(.25), rev=TRUE)
rect(s[, 1], ys - hlfw, s[, 2], ys + hlfw, col=clr, border=clr)
text(rowMeans(s), ys, paste('n =', df$n), cex=.8)
axis(1, at=as.numeric(ds), labels=strftime(ds, '%b %Y'))

字符串


的数据
请注意,我不需要 eventcolor 列,也没有使用额外的包。

  • 数据:*
df <- data.frame(debut=c(rep(2010, 3), rep(2011, 2), 2012), 
                 fin=c(2011, 2012, 2013, 2012, 2013, 2013), 
                 n=c(3, 1, 2, 6, 7, 5)
                 # , event=paste("n =", c(3, 1, 2, 6, 7, 5), sep=" "), 
                 # color=c("#D73027", "#F46D43", "#FDAE61", "#FEE08B", "#D9EF8B", "#A6D96A")
                 )

tag5nh1u

tag5nh1u3#

你可以使用ggplot。只需使用n控制linewidth美学来绘制线段。

library(ggplot2)

ggplot(df, aes(debut, -seq_along(debut), color = color)) +
  geom_segment(aes(xend = fin, yend = -seq_along(debut), linewidth = n)) +
  geom_text(aes(label = event), color = "black", nudge_x = 10, 
            hjust = 0, size = 8) +
  scale_linewidth_continuous(range = c(10, 30), guide = "none") +
  scale_y_continuous(NULL, expand = c(0.2, 0)) +
  scale_color_identity() +
  theme_bw(base_size = 24) +
  theme(axis.text.y = element_blank(), 
        axis.ticks.y = element_blank(),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank())

字符串


的数据

相关问题