Question

所以我正在阅读this post并且我爱上了日历热图和俄罗斯方块风格的月休息。

然而，ggplot示例没有实现俄罗斯方块休息，这可以说是最好的部分。

所以，FTFY，gist here：

results

这个程序是：

为您的数据创建适当的俄罗斯方块中断
left_join您的数据与（1）
使用一些特制的ggplot s

geom

（1）的方法相当简单，在gist的calendar_tetris_data(...)函数中实现，尽管让它更灵活一点会很好。

我的问题主要围绕（3）：如何将7 geom捆绑在一起，以便将中断分为单个程序或geom？

如果我这样做：

calendar_tetris_geoms <- function() {
  geom_segment(aes(x=x, xend=x, y=ymin, yend=ymax)) +                    # (a)
    geom_segment(aes(x=xmin, xend=xmax, y=y, yend=y)) +                  # (b)
    geom_segment(aes(x=dec.x, xend=dec.x, y=dec.ymin, yend=dec.ymax)) +  # (c)
    geom_segment(aes(x=nye.xmin, xend=nye.xmax, y=nye.y, yend=nye.y)) +  # (d)
    geom_segment(x=-0.5, xend=51.5, y=7.5, yend=7.5) +                   # put a line along the top
    geom_segment(x=0.5, xend=52.5, y=0.5, yend=0.5) +                    # put a line along the bottom
    geom_text(aes(x=month.x, y=month.y, label=month.l), hjust=0.25)      # (e)

}

然后尝试将其添加到我的ggplot，它不起作用：

> ggplot(data) + calendar_tetris_geoms()
Error in calendar_tetris_geoms() : 
  argument "plot" is missing, with no default

我显然不明白这是如何运作的。这是如何运作的？

Answer 1

修改@ baptiste的建议，如果我这样做：

calendar_tetris_geoms <- function() {
  list(
    geom_segment(aes(x=x, xend=x, y=ymin, yend=ymax)),                 # (a)
    geom_segment(aes(x=xmin, xend=xmax, y=y, yend=y)),                 # (b)
    geom_segment(aes(x=dec.x, xend=dec.x, y=dec.ymin, yend=dec.ymax)), # (c)
    geom_segment(aes(x=nye.xmin, xend=nye.xmax, y=nye.y, yend=nye.y)), # (d)
    geom_segment(x=-0.5, xend=51.5, y=7.5, yend=7.5),                  # put a line along the top
    geom_segment(x=0.5, xend=52.5, y=0.5, yend=0.5),                   # put a line along the bottom
    geom_text(aes(x=month.x, y=month.y, label=month.l), hjust=0.25)    # (e)
  )
}

然后这是一种享受：

calendar_tetris_data(min(stock.data$date), max(stock.data$date)) %>% 
  left_join(stock.data) %>% 
  ggplot() + 
  geom_tile(aes(x=week, y=wday2factor(wday), fill = Adj.Close), colour = "white") + 
  calendar_tetris_geoms() + 
  facet_wrap(~ year, ncol = 1)

Answer 2

更新2019-08-06-将所有内容汇总到一个帖子中以制作俄罗斯方块日历热图

采样日期数据。

这是您的日期数据的代表。

mydatedata<-as.Date(paste(sample(c(2018:2019), 3000, replace = TRUE), # year
                          sample(c(1:12),      3000, replace = TRUE), # month
                          sample(c(1:28),      3000, replace = TRUE), # day
                          sep="-"))

创建一个汇总数据的数据框

将mydatedata替换为您的df$date字段。

newdf<-as.data.frame(table(mydatedata), stringsAsFactors = FALSE); 
names(newdf)<-c("date", "n")
newdf$date<-as.Date(newdf$date, format='%Y-%m-%d')

创建日历俄罗斯方块数据功能

注意：我创建了一个工作日标签，重命名了几个函数以避免名称冲突，并将帮助器函数移到了主函数中。

原始来源链接：

1）https://gist.github.com/dvmlls/5f46ad010bea890aaf17

2）calendar heat map tetris chart

calendar_tetris_data <- function(date_min, date_max) {

  year2 <- function(d) as.integer(format(d, '%Y'))

  wday2 <- function(d) {
    n <- as.integer(format(d, '%u'))
    ifelse(n==7, 0, n) + 1 # I want the week to start on Sunday=1, so turn 7 into 0.
  }

  wday2factor <- function(wd) factor(wd, levels=1:7, labels=c('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'))

  week2 <- function(d, year) { 
    # If January 1st is a Sunday, my weeks will start from 1 instead of 0 like the rest of them. 
    nyd <- as.Date(ISOdate(year, 1, 1))
    # So if that's the case, subtract 1. 
    as.integer(format(d, '%U')) - ifelse(wday2(nyd) == 1, 1, 0)
  }

  start <- as.Date(ISOdate(year2(min(date_min)),1,1))
  end <- as.Date(ISOdate(year2(max(date_max)), 12, 31))

  all.dates <- start + 0:as.integer(end - start, units='days')

  data.frame(date=all.dates) %>% tbl_df %>% 
    mutate(
      wday=wday2(date),
      year=year2(date),
      month=as.integer(format(date, '%m')),
      week=week2(date, year),
      day=as.integer(format(date, '%d')),
      weekday=wday2factor(wday), #20190806, adding weekday label


      # (a) put vertical lines to the left of the first week of each month
      x=ifelse(day <= 7, week - 0.5, NA),
      ymin=ifelse(day <= 7, wday - 0.5, NA),
      ymax=ifelse(day <= 7, wday + 0.5, NA),

      # (b) put a horizontal line at the bottom of the first of each month
      y=ifelse(day == 1, wday - 0.5, NA),
      xmin=ifelse(day == 1, week - 0.5, NA),
      xmax=ifelse(day == 1, week + 0.5, NA),

      # (c) in december, put vertical lines to the right of the last week
      dec.x=ifelse(month==12 & day >= 25, week + 0.5, NA),
      dec.ymin=ifelse(month==12 & day >= 25, wday - 0.5, NA),
      dec.ymax=ifelse(month==12 & day >= 25, wday + 0.5, NA),

      # (d) put a horizontal line at the top of New Years Eve
      nye.y=ifelse(month==12 & day == 31, wday + 0.5, NA),
      nye.xmin=ifelse(month==12 & day == 31, week - 0.5, NA),
      nye.xmax=ifelse(month==12 & day == 31, week + 0.5, NA),

      # (e) put the first letter of the month on the first day
      month.x=ifelse(day == 1, week, NA),
      month.y=ifelse(day == 1, wday, NA),
      month.l=ifelse(day == 1, substr(format(date, '%B'), 1, 3), NA)
    )
}

创建ggplot2几何图形：

calendar_tetris_geoms <- function() {
  list(
    geom_segment(aes(x=x, xend=x, y=ymin, yend=ymax)),                 # (a)
    geom_segment(aes(x=xmin, xend=xmax, y=y, yend=y)),                 # (b)
    geom_segment(aes(x=dec.x, xend=dec.x, y=dec.ymin, yend=dec.ymax)), # (c)
    geom_segment(aes(x=nye.xmin, xend=nye.xmax, y=nye.y, yend=nye.y)), # (d)
    geom_segment(x=-0.5, xend=51.5, y=7.5, yend=7.5),                  # put a line along the top
    geom_segment(x=0.5, xend=52.5, y=0.5, yend=0.5),                   # put a line along the bottom
    geom_text(aes(x=month.x, y=month.y, label=month.l), hjust=0.25)    # (e)
  )
}

创建情节：

library(ggplot2)
library(dplyr) # for %>% pipe


calendar_tetris_data(min(newdf$date), max(newdf$date)) %>% 
  left_join(newdf) %>% 
  ggplot() + 
    geom_tile(aes(x=week, y=weekday, fill = n), colour = "white") + 
    calendar_tetris_geoms() + 
    facet_wrap(~ year, ncol = 1)

日历热图俄罗斯方块图表

2 个答案:

采样日期数据。

创建一个汇总数据的数据框

创建日历俄罗斯方块数据功能

创建ggplot2几何图形：

创建情节：