使用ggplot2创建月度/年度日历图像

Question

我开始在Excel中制作日历，但认为在R中可能很容易做到。 （注意：我知道各种热图日历套餐，但我更喜欢使用ggplot2。）最后我想制作一个从给定日期开始显示12个月的日历，每个月作为一个小框显示4或y轴5周（顶部的第1周，底部的第4周或第5周）和沿x轴的星期几（从星期一开始）。

我认为这将是一个15分钟的工作（创建所有月份的数据，使用reshape格式化然后使用facet_wrap）但几乎立即遇到问题，如下图所示 - 这个月的日子不合适，虽然一周的日子似乎没问题。在R中订购数据是我的克星;我真的应该对此有所了解。无论如何，下面的图像显示了我到目前为止的代码，代码低于该代码。这只是一个有趣的项目，并不紧急，但欢迎任何帮助和/或装饰。

require(ggplot2)
require(scales)
require(lubridate)

date.start <- as.Date('2013-09-01')
date.end <- date.start + months(1)

mydf <- data.frame(mydate = seq(as.Date(date.start),
                       as.Date(date.end) - days(1),
                       by = 'day'))

mydf$month <- month(mydf$mydate)
mydf$week <- week(mydf$mydate)
mydf$day <- day(mydf$mydate)
mydf$dow <- as.factor(format(mydf$mydate, format = "%a"))
levels(mydf$dow) <- c('Mon','Tue','Wed','Thu','Fri','Sat','Sun')

ggplot(mydf, aes(x = dow, y = as.factor(week))) +
    geom_tile(colour = "black", fill = "white", label = mydf$day) +
    geom_text(label = mydf$day, size = 4, colour = "black") +
    scale_x_discrete(expand = c(0,0)) +
    theme(axis.ticks = element_blank()) +
    theme(axis.title.y = element_blank()) +
    theme(axis.title.x = element_blank()) +
    theme(panel.background = element_rect(fill = "transparent"))+
    theme(legend.position = "none") +
    theme()

Answer 1

这行代码错误：

levels(mydf$dow) <- c('Mon','Tue','Wed','Thu','Fri','Sat','Sun')

这是因为mydf$dow已经是一个因素，而使用levels只是重命名当前级别。在这种情况下，您只需将"Fri" "Mon" "Sat" "Sun" "Thu" "Tue" "Wed"重命名为'Mon','Tue','Wed','Thu','Fri','Sat','Sun'，这将导致您最终获得的混乱。

如果您在示例中查看mydf，您会看到：

       mydate month week day dow
1  2013-09-01     9   35   1 Thu
2  2013-09-02     9   36   2 Tue
3  2013-09-03     9   36   3 Sat
4  2013-09-04     9   36   4 Sun
5  2013-09-05     9   36   5 Fri
6  2013-09-06     9   36   6 Mon
7  2013-09-07     9   36   7 Wed

由于重命名，天数名称不再与日期匹配。

纠正后，一切都按预期进行：

require(ggplot2)
require(scales)
require(lubridate)


date.start <- as.Date('2013-09-01')
date.end <- date.start + months(1)

mydf <- data.frame(mydate = seq(as.Date(date.start),
                                as.Date(date.end) - days(1),
                                by = 'day'))

mydf$month <- month(mydf$mydate)
mydf$week <- week(mydf$mydate)
mydf$day <- day(mydf$mydate)
mydf$dow <- as.factor(format(mydf$mydate, format = "%a"))

mydf$dow <- factor(mydf$dow, levels=c('Mon','Tue','Wed','Thu','Fri','Sat','Sun'))

ggplot(mydf, aes(x = dow, y = as.factor(week))) +
  geom_tile(colour = "black", fill = "white", label = mydf$day) +
  geom_text(label = mydf$day, size = 4, colour = "black") +
  scale_x_discrete(expand = c(0,0)) +
  theme(axis.ticks = element_blank()) +
  theme(axis.title.y = element_blank()) +
  theme(axis.title.x = element_blank()) +
  theme(panel.background = element_rect(fill = "transparent"))+
  theme(legend.position = "none") +
  theme()

Answer 2

以相反顺序创建具有级别的week.f列。我们使用了"%U"（假设是美国惯例，但如果您希望英国惯例使用"%W"，并且还要更改dow的因子级别的顺序。此外，我们允许任意日期输入计算月初，并略微简化了ggplot来电。

library(ggplot2)

input <- as.Date("2013-09-11") # input date

st <- as.Date(cut(input, "month")) # calculate start of month
dates31 <- st + 0:30 # st and next 30 dates (31 in all)
dates <- dates31[months(dates31) == months(st)] # keep only dates in st's month

week.ch <- format(dates, "%U") # week numbers

mydf <- data.frame(
   day = as.numeric(format(dates, "%d")),
   week.f = factor(week.ch, rev(unique(week.ch))),
   dow = factor(format(dates, "%a"), c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"))
)

ggplot(mydf, aes(x = dow, y = week.f)) +
    geom_tile(colour = "black", fill = "white") +
    geom_text(label = mydf$day, size = 4) + 
    scale_x_discrete(expand = c(0,0)) +
    theme(axis.ticks = element_blank()) +
    theme(axis.title = element_blank()) +
    theme(panel.background = element_rect(fill = "transparent"))+
    theme(legend.position = "none")

顺便说一句，在TeachingDemos包中有一个cal函数，可以使用经典图形构建一个月的日历。

Answer 3

你走了：

start <- as.Date("2013-09-1")
numdays <- 30

weeknum <- function(date){
  z <- as.Date(date, format="%Y-%m-%d")
  as.numeric( format(z-1, "%U"))
}


dates <- data.frame(date=seq(start, length.out=numdays, by="1 day"))
dates <- within(dates, {
  weeknum <- weeknum(date)
  month   <- format(date, "%m")
  weekday <- format(date, "%a")
  day     <- format(date, "%d")
})

dates$weekday <- factor(dates$weekday, levels=c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"))

library(ggplot2)
ggplot(dates, aes(x=weekday, y=weeknum)) + 
  geom_tile(fill="blue", col="white") +
  geom_text(aes(label=day))