R 沿 x 轴（时间间隔）注释热图

时间：2021-07-26 04:48:28

标签： r ggplot2 

# load libraries
library(ggplot2)
library(viridis)
library(lubridate)
library(ggExtra)
library(tidyverse)

# read 
checkin_malaysia_time <- read_csv(file = 'https://raw.githubusercontent.com/MoH-Malaysia/covid19-public/main/mysejahtera/checkin_malaysia_time.csv')

# pivot longer for ggplot
checkin_malaysia_time <- checkin_malaysia_time %>%
 pivot_longer(!date, names_to = "hour", values_to = "count")
checkin_malaysia_time

# date feats
checkin_malaysia_time <- checkin_malaysia_time %>% 
 dplyr::mutate(day = lubridate::day(date),
               month = lubridate::month(date),
               year = lubridate::year(date),
               ith_hour = as.integer(hour),
               yearmon = as.factor(zoo::as.yearmon(date))) %>% 
 dplyr::select(yearmon, day, ith_hour, month, year, count)
# map hour
checkin_malaysia_time$hour <- rep(rep(0:23,each = 2),237)

# hourly data
checkin_malaysia_time_hour <- checkin_malaysia_time %>%
 group_by(yearmon, day, month, year, hour) %>% 
 summarise(count = sum(count)) %>% ungroup()

# plot
p <-ggplot(checkin_malaysia_time_hour,
           aes(day,hour,fill=count))+
 geom_tile(color= "white",size=0.1) + coord_equal() + 
 scale_fill_viridis(name="Hourly checkins",option ="H")
p <-p + facet_wrap(year~month, nrow = 1)
p <-p + scale_y_continuous(trans = "reverse", breaks = seq(0,23,2))
p <-p + scale_x_continuous(breaks =sort(c(1,seq(5,25,5),31)))
p <-p + theme_minimal(base_size = 8)
p <-p + labs(title= paste("Checkin Time Density",' - MySejahtera'), x="Day", y="Hour")
p <-p + theme(legend.position = "right") +
 theme(plot.title=element_text(size = 14))+
 theme(axis.text.y=element_text(size=6)) +
 theme(strip.background = element_rect(colour="white"))+
 theme(plot.title=element_text(hjust=0))+
 theme(axis.ticks=element_blank())+
 theme(axis.text=element_text(size=7))+
 theme(legend.title=element_text(size=8))+
 theme(legend.text=element_text(size=6))+ 
 removeGrid()
p

我想根据时间间隔注释下面的热图。 例如来自 15th Jan to 15th February: lockdown、11th March 20th March: festive period、31st May: Outlier

enter image description here

1 个答案:

答案 0 :(得分：1)

您可以使用网格“手动”绘制线条，例如

# load libraries
library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
library(ggExtra)
library(grid)
library(pBrackets)

# read 
checkin_malaysia_time <- read_csv(file = 'https://raw.githubusercontent.com/MoH-Malaysia/covid19-public/main/mysejahtera/checkin_malaysia_time.csv')
#> 
#> ── Column specification ────────────────────────────────────────────────────────
#> cols(
#>   .default = col_double(),
#>   date = col_date(format = "")
#> )
#> ℹ Use `spec()` for the full column specifications.

# pivot longer for ggplot
checkin_malaysia_time <- checkin_malaysia_time %>%
  pivot_longer(!date, names_to = "hour", values_to = "count")
checkin_malaysia_time
#> # A tibble: 11,376 x 3
#>    date       hour  count
#>    <date>     <chr> <dbl>
#>  1 2020-12-01 0      6395
#>  2 2020-12-01 1      4052
#>  3 2020-12-01 2      2611
#>  4 2020-12-01 3      2005
#>  5 2020-12-01 4      1660
#>  6 2020-12-01 5      1574
#>  7 2020-12-01 6      1371
#>  8 2020-12-01 7      1421
#>  9 2020-12-01 8      1736
#> 10 2020-12-01 9      3316
#> # … with 11,366 more rows

# date feats
checkin_malaysia_time <- checkin_malaysia_time %>% 
  dplyr::mutate(day = lubridate::day(date),
                month = lubridate::month(date),
                year = lubridate::year(date),
                ith_hour = as.integer(hour),
                yearmon = as.factor(zoo::as.yearmon(date))) %>% 
  dplyr::select(yearmon, day, ith_hour, month, year, count)
# map hour
checkin_malaysia_time$hour <- rep(rep(0:23,each = 2),237)

# hourly data
checkin_malaysia_time_hour <- checkin_malaysia_time %>%
  group_by(yearmon, day, month, year, hour) %>% 
  summarise(count = sum(count)) %>% ungroup()
#> `summarise()` has grouped output by 'yearmon', 'day', 'month', 'year'. You can override using the `.groups` argument.

png(filename = "example_1.png", width = 1080, height = 360)
# plot
p <- ggplot(checkin_malaysia_time_hour,
           aes(day,hour,fill=count))+
  geom_tile(color= "white",size=0.1) + coord_equal() + 
  scale_fill_viridis_c(name="Hourly checkins",option ="H") +
facet_wrap(year~month, nrow = 1) +
scale_y_continuous(trans = "reverse", breaks = seq(0,23,2)) +
scale_x_continuous(breaks =sort(c(1,seq(5,25,5),31))) +
theme_minimal(base_size = 8) +
labs(title= paste("Checkin Time Density",' - MySejahtera'), x="Day", y="Hour") +
  theme(legend.position = "right") +
  theme(plot.title=element_text(size = 14))+
  theme(axis.text.y=element_text(size=6)) +
  theme(strip.background = element_rect(colour="white"))+
  theme(plot.title=element_text(hjust=0))+
  theme(axis.ticks=element_blank())+
  theme(axis.text=element_text(size=7))+
  theme(legend.title=element_text(size=8))+
  theme(legend.text=element_text(size=6))+ 
  removeGrid()
p

grid.brackets(unit(0.4, "npc"), 130, unit(0.52, "npc"), 130, lwd=2, col="red")
grid.text(label = "Festive period", x = unit(0.471, "npc"), y = unit(0.711, "npc"),
          gp=gpar(fontsize=12, col="red"))
grid.brackets(unit(0.29, "npc"), 260, unit(0.18, "npc"), 260, lwd=2, col="red")
grid.text(label = "Lockdown", x = unit(0.232, "npc"), y = unit(0.2, "npc"),
          gp=gpar(fontsize=12, col="red"))
grid.lines(x = unit(c(0.69, 0.69), "npc"),
           y = unit(c(0.2, 0.3), "npc"),
           gp = gpar(col = "red", fill="red"),
           arrow = arrow(length = unit(0.2, "inches"), 
                         ends="last", type="closed"))
grid.text(label = "Outlier", x = unit(0.69, "npc"), y = unit(0.16, "npc"),
          gp=gpar(fontsize=12, col="red"))
dev.off()

example_1.png

由 reprex package (v2.0.0) 于 2021 年 7 月 26 日创建

这种方法有优点也有缺点：通过一些调整，您可以使注释看起来与您希望的完全一样，但是您必须准确指定它们将在绘图上的哪个位置绘制，并且您不能重新缩放绘图动态，即您需要在绘制线条之前指定最终图的尺寸。

有关网格图形的更多信息：

相关问题
最新问题