R语言 如何在同一个x轴上显示周和月?

hgb9j2n6  于 2023-03-05  发布在  其他
关注(0)|答案(1)|浏览(157)

我尝试在同一图表中显示每周数据的“放大”版本,以及相同数据的整体、每月版本。

这里有一个例子,我试图实现。
我对ggplot2还是个新手,但这正是我想用的工具。有什么建议吗?
以下是dput的一些示例数据

structure(list(Date = structure(c(19051, 19052, 19053, 19054, 
19055, 19056, 19057, 19058, 19059, 19060, 19061, 19062, 19063, 
19064, 19065, 19066, 19067, 19068, 19069, 19070, 19071, 19072, 
19073, 19074, 19075, 19076, 19077, 19078, 19079, 19080, 19081, 
19082, 19083, 19084, 19085, 19086, 19087, 19088, 19089, 19090, 
19091, 19092, 19093, 19094, 19095, 19096, 19097, 19098, 19099, 
19100, 19101, 19102, 19103, 19104, 19105, 19106, 19107, 19108, 
19109, 19110, 19111, 19112, 19113, 19114, 19115, 19116, 19117, 
19118, 19119, 19120, 19121, 19122, 19123, 19124, 19125, 19126, 
19127, 19128, 19129, 19130, 19131, 19132, 19133, 19134, 19135, 
19136, 19137, 19138, 19139, 19140, 19141, 19142, 19143, 19144, 
19145, 19146, 19147, 19148, 19149, 19150, 19151, 19152, 19153, 
19154, 19155, 19156, 19157, 19158, 19159, 19160, 19161, 19162, 
19163, 19164, 19165, 19166, 19167, 19168, 19169, 19170, 19171, 
19172, 19173, 19174, 19175, 19176, 19177, 19178, 19179, 19180, 
19181, 19182, 19183, 19184, 19185, 19186, 19187, 19188, 19189, 
19190, 19191, 19192, 19193, 19194, 19195, 19196, 19197, 19198, 
19199, 19200, 19201, 19202, 19203, 19204, 19205, 19206, 19207, 
19208, 19209, 19210, 19211, 19212, 19213, 19214, 19215, 19216, 
19217, 19218, 19219, 19220, 19221, 19222, 19223, 19224, 19225, 
19226, 19227, 19228, 19229, 19230, 19231, 19232, 19233, 19234, 
19235, 19236, 19237, 19238, 19239, 19240, 19241, 19242, 19243, 
19244, 19245, 19246, 19247, 19248, 19249, 19250, 19251, 19252, 
19253, 19254, 19255, 19256, 19257, 19258, 19259, 19260, 19261, 
19262, 19263, 19264, 19265, 19266, 19267, 19268, 19269, 19270, 
19271, 19272, 19273, 19274, 19275, 19276, 19277, 19278, 19279, 
19280, 19281, 19282, 19283, 19284, 19285, 19286, 19287, 19288, 
19289, 19290, 19291, 19292, 19293, 19294, 19295, 19296, 19297, 
19298, 19299, 19300, 19301, 19302, 19303, 19304, 19305, 19306, 
19307, 19308, 19309, 19310, 19311, 19312, 19313, 19314, 19315, 
19316, 19317, 19318, 19319, 19320, 19321, 19322, 19323, 19324, 
19325, 19326, 19327, 19328, 19329, 19330, 19331, 19332, 19333, 
19334, 19335, 19336, 19337, 19338, 19339, 19340, 19341, 19342, 
19343, 19344, 19345, 19346, 19347, 19348, 19349, 19350, 19351, 
19352, 19353, 19354, 19355, 19356, 19357, 19358, 19359, 19360, 
19361, 19362, 19363, 19364, 19365, 19366, 19367, 19368, 19369, 
19370, 19371, 19372, 19373, 19374, 19375, 19376, 19377, 19378, 
19379, 19380, 19381, 19382, 19383, 19384, 19385, 19386, 19387, 
19388, 19389, 19390, 19391, 19392, 19393, 19394, 19395, 19396, 
19397, 19398, 19399, 19400, 19401, 19402, 19403, 19404, 19405, 
19406, 19407, 19408, 19409, 19410, 19411, 19412, 19413, 19414, 
19415), class = "Date"), Random_Integer = c(578L, 413L, 594L, 
517L, 698L, 628L, 643L, 413L, 552L, 489L, 490L, 655L, 596L, 490L, 
536L, 425L, 406L, 536L, 653L, 610L, 477L, 480L, 442L, 542L, 431L, 
508L, 662L, 422L, 534L, 623L, 565L, 616L, 689L, 468L, 471L, 475L, 
462L, 540L, 609L, 552L, 693L, 676L, 440L, 489L, 622L, 415L, 515L, 
493L, 661L, 634L, 485L, 438L, 558L, 639L, 608L, 433L, 403L, 412L, 
468L, 642L, 677L, 488L, 424L, 690L, 685L, 558L, 520L, 509L, 557L, 
463L, 598L, 466L, 550L, 484L, 564L, 535L, 450L, 473L, 577L, 635L, 
497L, 613L, 526L, 611L, 573L, 672L, 631L, 642L, 679L, 512L, 506L, 
550L, 553L, 501L, 654L, 559L, 554L, 404L, 671L, 679L, 687L, 676L, 
454L, 637L, 651L, 438L, 536L, 625L, 447L, 476L, 482L, 583L, 438L, 
595L, 656L, 567L, 685L, 493L, 671L, 419L, 594L, 563L, 451L, 421L, 
576L, 441L, 483L, 410L, 520L, 484L, 593L, 506L, 476L, 597L, 648L, 
599L, 559L, 649L, 691L, 415L, 432L, 439L, 409L, 599L, 524L, 664L, 
662L, 585L, 460L, 651L, 551L, 453L, 425L, 634L, 688L, 584L, 652L, 
514L, 409L, 453L, 604L, 666L, 424L, 451L, 681L, 614L, 559L, 456L, 
504L, 678L, 669L, 533L, 528L, 617L, 505L, 585L, 684L, 425L, 426L, 
406L, 644L, 553L, 440L, 611L, 621L, 558L, 544L, 456L, 547L, 562L, 
637L, 560L, 465L, 403L, 624L, 516L, 424L, 535L, 454L, 616L, 484L, 
444L, 545L, 569L, 533L, 598L, 575L, 644L, 503L, 598L, 609L, 624L, 
657L, 576L, 540L, 423L, 529L, 564L, 590L, 475L, 668L, 569L, 597L, 
633L, 463L, 479L, 435L, 690L, 652L, 447L, 510L, 678L, 694L, 621L, 
686L, 621L, 472L, 691L, 625L, 677L, 571L, 696L, 492L, 524L, 698L, 
438L, 636L, 564L, 506L, 432L, 482L, 676L, 608L, 475L, 493L, 690L, 
429L, 616L, 574L, 514L, 495L, 569L, 495L, 425L, 629L, 547L, 601L, 
480L, 631L, 642L, 505L, 410L, 512L, 540L, 430L, 514L, 677L, 493L, 
601L, 415L, 596L, 577L, 576L, 411L, 465L, 449L, 603L, 574L, 533L, 
521L, 658L, 647L, 688L, 447L, 499L, 507L, 700L, 409L, 569L, 679L, 
608L, 536L, 507L, 407L, 513L, 660L, 428L, 473L, 681L, 472L, 666L, 
661L, 623L, 603L, 610L, 618L, 583L, 554L, 518L, 466L, 509L, 533L, 
435L, 454L, 639L, 519L, 409L, 552L, 499L, 504L, 680L, 579L, 677L, 
640L, 423L, 566L, 446L, 590L, 436L, 573L, 453L, 606L, 418L, 599L, 
558L, 436L, 502L, 643L, 447L, 587L, 538L, 698L, 557L, 588L, 588L, 
456L, 437L, 483L, 573L, 529L, 519L, 599L, 420L, 598L, 486L)), class = "data.frame", row.names = c(NA, 
-365L))
hfyxw5xn

hfyxw5xn1#

实现所需结果的一个选项是创建两个单独的图,然后使用patchwork将它们粘合在一起:

library(dplyr)
library(lubridate)
library(ggplot2)
library(patchwork)

dat_week <- dat |>
  group_by(week = week(Date)) |>
  summarise(num = sum(Random_Integer)) |>
  filter(week >= 44 & week < 50) |>
  mutate(week = factor(week))

dat_month <- dat |>
  group_by(month = month(Date, label = TRUE)) |>
  summarise(num = sum(Random_Integer))

p_week <- ggplot(dat_week, aes(week, num, group = 1)) +
  geom_line() +
  geom_point() +
  ggrepel::geom_label_repel(aes(label = scales::comma(num)),
    nudge_y = 150,
    label.size = NA, fontface = "bold", direction = "y",
    min.segment.length = 10
  ) +
  scale_x_discrete(
    expand = c(0, 1, 0, 1.5),
    labels = ~ paste("WK", .x, sep = "\n")
  ) +
  scale_y_continuous(
    expand = c(0, 0), limits = c(1000, 5000),
    labels = scales::label_comma()
  ) +
  theme_minimal() +
  theme(
    axis.line.y.left = element_line(),
    plot.margin = margin(5.5, 0, 5.5, 5.5)
  )

p_month <- ggplot(dat_month, aes(month, num, group = 1)) +
  geom_line() +
  geom_point() +
  ggrepel::geom_label_repel(aes(label = scales::comma(num)),
    nudge_y = 150,
    label.size = NA, fontface = "bold", direction = "y",
    min.segment.length = 10
  ) +
  scale_x_discrete(expand = c(0, 1.5, 0, 1)) +
  scale_y_continuous(
    expand = c(0, 0), limits = c(14000, 18000),
    position = "right", labels = scales::label_comma()
  ) +
  theme_minimal() +
  theme(
    axis.line.y.right = element_line(),
    plot.margin = margin(5.5, 5.5, 5.5, 0)
  )

p_week + p_month &
  plot_layout(widths = c(1, 1.5)) &
  theme(
    panel.border = element_blank(),
    panel.grid = element_blank(),
    axis.text = element_text(face = "bold"),
    axis.text.y.right = element_text(color = "grey75"),
    axis.line.x.bottom = element_line()
  ) &
  coord_cartesian(clip = "off") &
  labs(x = NULL, y = NULL)

相关问题